留言區

留言列表:

Title

20240924

Option Explicit ' 引用 Windows API 函數 Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As LongPtr, ByVal hWndChildAfter As LongPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As LongPtr) As Long Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Long Sub GetWindowTextFromOtherProgram() Dim hWndParent As LongPtr Dim hWndChild As LongPtr Dim windowText As String Dim textLength As Long ' 找到指定的應用程式視窗 - 修改以下視窗標題名稱為你想要偵測的程式 hWndParent = FindWindow(vbNullString, "Notepad") ' 這裡用記事本作為範例 If hWndParent = 0 Then MsgBox "找不到指定的視窗" Exit Sub End If ' 找到視窗中的子視窗（例如編輯區域） hWndChild = FindWindowEx(hWndParent, 0, "Edit", vbNullString) If hWndChild = 0 Then MsgBox "找不到指定視窗的子視窗" Exit Sub End If ' 取得子視窗中的文字 textLength = GetWindowTextLength(hWndChild) + 1 windowText = String$(textLength, Chr$(0)) GetWindowText hWndChild, windowText, textLength ' 顯示子視窗中的文字內容 MsgBox "視窗文字內容: " & Left$(windowText, textLength - 1) End Sub

Title

ch2.初階變分法

Option Explicit

' Windows API declarations
Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hwnd As LongPtr) As Long
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long

' 定義POINT類型，包含X和Y座標
Type POINTAPI
空白X As Long
空白Y As Long
End Type

' 宣告Windows API函數來獲取鼠標位置
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
' 定義Windows API函數來設置鼠標位置
Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

' 定義Windows API函數來模擬鼠標點擊
Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

' 設置鼠標事件常量
Const MOUSEEVENTF_LEFTDOWN = &H2 ' 左鍵按下
Const MOUSEEVENTF_LEFTUP = &H4 ' 左鍵鬆開




Dim rowNumber As Long ' 儲存視窗標題的Excel行號

' Callback function for EnumWindows
Function EnumWindowsProc(ByVal hwnd As LongPtr, ByVal lParam As LongPtr) As Long
空白Dim windowTitle As String * 255
空白Dim titleLength As Long
空白
空白' Get the window title length
空白titleLength = GetWindowText(hwnd, windowTitle, Len(windowTitle))
空白
空白' If the window is visible and has a title
空白If IsWindowVisible(hwnd) And titleLength > 0 Then
空白空白windowTitle = Left$(windowTitle, titleLength)
空白空白
空白空白' 將視窗標題輸出到Excel表格
空白空白Sheets(1).Cells(rowNumber, 1).Value = windowTitle
空白空白rowNumber = rowNumber + 1 ' 移到下一行
空白End If
空白
空白EnumWindowsProc = 1 ' Continue enumeration
End Function

Sub ListAllOpenWindows()
空白Dim strfile As String
空白
空白strfile = Application.ActiveWorkbook.Name '本檔案的檔名
空白
空白ActiveWorkbook.Save
空白
空白' 初始化行號
空白rowNumber = 1
空白
空白' 清除Excel中的先前數據
空白Sheets(1).Cells.Clear
空白
空白' Enumerate all windows and list their titles in Excel
空白EnumWindows AddressOf EnumWindowsProc, 0
空白
空白Dim str As String
空白str = Sheets(2).Cells(1, 1) & Sheets(2).Cells(2, 1)
空白
空白
空白' 將Chrome視窗叫到台前
空白ActivateChromeWindow
空白
空白' 模擬按Tab鍵并依次?入
空白'SimulateTabAndInput
空白
空白
空白' 移動鼠標並模擬點擊
空白MoveMouseAndClick
空白'Application.Wait Now + TimeValue("00:00:01")
空白SendKeys "{DEL}", True
空白'Application.Wait Now + TimeValue("00:00:01")
空白'SendKeys "雅云程式衝衝衝", True
空白'SendKeys "雅云程式衝衝衝", True
空白
空白SendKeys str, True
空白
空白SetCursorPos 650, 900
空白Application.Wait Now + TimeValue("00:00:02")
空白' 模擬鼠標左鍵按下
空白mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
空白' 模擬鼠標左鍵鬆開
空白mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
空白SendKeys "雅云程式衝衝衝", True
空白
空白Beep
End Sub

' 將Chrome視窗叫到台前
Sub ActivateChromeWindow()
空白Dim hwnd As LongPtr
空白
空白' 使用FindWindow找到Chrome視窗
空白hwnd = FindWindow("Chrome_WidgetWin_1", vbNullString)
空白
空白' 如果找到視窗則將其置前
空白If hwnd <> 0 Then
空白空白SetForegroundWindow hwnd
空白Else
空白空白MsgBox "Chrome window not found!"
空白End If
End Sub

' 模擬按Tab鍵并依次?入
Sub SimulateTabAndInput()
空白Dim i As Integer
空白' ?停一段??，确保Chrome窗口已激活
空白Application.Wait Now + TimeValue("00:00:02")
空白
空白' 遍??入框并依次?入1,2,3...
空白For i = 1 To 10 ' 假?有10?可?入的框（根据需要?整此值）
空白空白SendKeys "{TAB}", True ' 模?按Tab?移?到下一??入框
空白空白Application.Wait Now + TimeValue("00:00:01") ' 确保Tab?完成
空白空白
空白空白SendKeys CStr(i), True ' 在?前?入框中?入?字
空白空白Application.Wait Now + TimeValue("00:00:01") ' 稍作停?，确保?入完成
空白Next i
End Sub

Option Explicit

' 定義POINT類型，包含X和Y座標
Type POINTAPI
空白X As Long
空白Y As Long
End Type

' 宣告Windows API函數來獲取鼠標位置
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
' 定義Windows API函數來設置鼠標位置
Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

' 定義Windows API函數來模擬鼠標點擊
Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

' 設置鼠標事件常量
Const MOUSEEVENTF_LEFTDOWN = &H2 ' 左鍵按下
Const MOUSEEVENTF_LEFTUP = &H4 ' 左鍵鬆開

' 移動鼠標並模擬點擊
Sub MoveMouseAndClick()
空白' 移動鼠標到指定位置
空白SetCursorPos 320, 110
空白Application.Wait Now + TimeValue("00:00:02")
空白' 模擬鼠標左鍵按下
空白mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
空白' 模擬鼠標左鍵鬆開
空白mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
空白
End Sub



Sub GetMousePosition_1()
空白Dim mousePos As POINTAPI ' 用來儲存鼠標位置的變量
空白
空白' 獲取鼠標位置
空白GetCursorPos mousePos
空白
空白' 將鼠標位置填入Sheet(1)的單元格
空白Sheets(1).Cells(1, 5).Value = "X: " & mousePos.X
空白Sheets(1).Cells(1, 6).Value = "Y: " & mousePos.Y
空白Dim i As Integer
空白
空白i = 1
空白'For i = 1 To 10
空白空白'Application.Wait Now + TimeValue("00:00:02")
空白空白Sheets(1).Cells(i, 5).Value = "X: " & mousePos.X
空白空白Sheets(1).Cells(i, 6).Value = "Y: " & mousePos.Y
空白'Next i
空白
空白Dim X As Long
空白Dim Y As Long
空白
空白' 設置目標位置
空白X = 320
空白Y = 110
空白
空白' 移動鼠標到目標位置
空白SetCursorPos X, Y
空白'Beep
空白
空白
End Sub

Sub GetMousePosition_2()
空白Dim mousePos As POINTAPI ' 用來儲存鼠標位置的變量
空白
空白' 獲取鼠標位置
空白GetCursorPos mousePos
空白
空白' 將鼠標位置填入Sheet(1)的單元格
空白Sheets(1).Cells(1, 5).Value = "X: " & mousePos.X
空白Sheets(1).Cells(1, 6).Value = "Y: " & mousePos.Y
空白Dim i As Integer
空白
空白i = 1
空白'For i = 1 To 10
空白空白'Application.Wait Now + TimeValue("00:00:02")
空白空白Sheets(1).Cells(i, 5).Value = "X: " & mousePos.X
空白空白Sheets(1).Cells(i, 6).Value = "Y: " & mousePos.Y
空白'Next i
空白
空白Dim X As Long
空白Dim Y As Long
空白
空白' 設置目標位置
空白X = 650
空白Y = 900
空白
空白' 移動鼠標到目標位置
空白SetCursorPos X, Y
空白'Beep
空白
空白
End Sub

Title

ch2.初階變分法

VBA-ch4-20240213-perri

Sub find() '填入任意數字，數出每個數字出現幾次'

Public strfile As String '本檔案的檔名
Public strpath As String '本檔案在的路徑
Public str_OS As String

Public Const col_offset As Integer = 30


Type manufactor_info_row
 Tyre_Code As Integer
 Tyre_ID As Integer
 KMN_Set As Integer
 Quantity As Integer
 In_stock As Integer
 Quality As Integer
 Location As Integer
 sorting_process(3) As String '排序條件
End Type

Public Const type_max_count As Integer = 100 'should be max!!!
Public type_count As Integer
Public Const manufator_count As Integer = 5 'should be max!!!
Public Const area_max_count As Integer = 50 'should be max!!!
Public manufactor_row(manufator_count) As manufactor_info_row


'訂單資訊
Type order_form
 ship_day As String
 ship_destiny As String
 order_quantitiy As LongLong
 primary_type As Integer
 primary_type_code As String
 choice_type_count As Integer
 choice_type_list(10) As String
End Type
Public order_plan(100) As order_form
Public order_count As Integer


'產品選取資訊
Type product_info
 type_code As String
 type_name As String
 first_time As String
 first_row As LongLong
 first_availible_row As LongLong
 end_row As LongLong
 total_availible_count As LongLong
 num_of_choice As Integer 'how many manufactor/area can choice
 manufator_code As Integer '1:Mic,2:Bris,3:Per
 expire_day As LongLong
 mini_quantity As LongLong
 can_mix As Boolean
 mix_count As Integer
 mix_type(10) As Integer
 activate_find As Boolean
End Type
Public product_list(type_max_count, manufator_count, area_max_count) As product_info
Public area_sort_sequence(type_max_count, manufator_count, area_max_count) As Integer
'product_list(i, 0, 0)紀錄那個type總資訊
'product_list(i, j, 0)那個area總資訊

Public global_output_row As LongLong
Public VBA_mode As Integer

Type VBA_mode_manufactor_choice
 num_of_manufactor As Integer
 manufactor_code(10) As Integer
 manufactor_produce_file(10) As String
 manufactor_produce_excel(10) As String
End Type
Public manufactor_choice_mode(5) As VBA_mode_manufactor_choice



Sub define_info()
 'save_file
 
 Dim head_line(50) As String
 head_line(1) = "F1 Tyre Number"
 head_line(2) = "Tyre ID"
 head_line(3) = "KMN-Set"
 head_line(4) = "Quantity"
 head_line(5) = "In stock"
 head_line(6) = "Quality"
 head_line(7) = "Location"
 
 Dim manufactor As Integer
 
 'manufactor_choice_mode(1).num_of_manufactor = 2 ' MICHELIN and'BRIDGESTONE
 'manufactor_choice_mode(2).num_of_manufactor = 1 'PIRELLI
 
 manufactor = 1 ' MICHELIN
 With manufactor_row(manufactor)
  .Tyre_Code = 1
  .Tyre_ID = 2
  .KMN_Set = 3
  .Quantity = 4
  .In_stock = 5
  .Quality = 6
  .Location = 7
  .sorting_process(1) = Chr(64 + .In_stock) & "1"
  .sorting_process(2) = Chr(64 + .Tyre_ID) & "1"
  .sorting_process(3) = Chr(64 + .KMN_Set) & "1"
 End With
 
 manufactor = 2 'BRIDGESTONE
 With manufactor_row(manufactor)
  .Tyre_Code = 3 '1
  .Tyre_ID = 1 '2
  .KMN_Set = 5 '3
  .Quantity = 2 '4
  .In_stock = 6 '5
  .Quality = 4 '6
  .Location = 7 '7
  .sorting_process(1) = Chr(64 + .In_stock) & "1"
  .sorting_process(2) = Chr(64 + .Tyre_ID) & "1"
  .sorting_process(3) = Chr(64 + .KMN_Set) & "1"
 End With
 
 manufactor = 3 'PIRELLI
 With manufactor_row(manufactor)
  .Tyre_Code = 2 '1
  .Tyre_ID = 3 '2
  .KMN_Set = 7 '3
  .Quantity = 5 '4
  .In_stock = 1 '5
  .Quality = 6 '6
  .Location = 4 '7
  .sorting_process(1) = Chr(64 + .Location) & "1"
  .sorting_process(2) = Chr(64 + .In_stock) & "1"
  .sorting_process(3) = Chr(64 + .Tyre_ID) & "1"
 End With
 
 i = 2
 type_count = 0
 Do Until Workbooks(strfile).Sheets("type_information").Cells(i, 1) = 0
  type_count = type_count + 1
  For j = 0 To manufactor_choice_mode(VBA_mode).num_of_manufactor 'manufator_count
   For k = 0 To area_max_count
    With product_list(type_count, j, k)
     .type_code = Workbooks(strfile).Sheets("type_information").Cells(i, 1)
     .type_name = Workbooks(strfile).Sheets("type_information").Cells(i, 2)
     .expire_day = Workbooks(strfile).Sheets("type_information").Cells(i, 3)
     .mini_quantity = Workbooks(strfile).Sheets("type_information").Cells(i, 4)
     
     .first_time = Date '""
     .first_row = 1
     .end_row = 1
     .total_availible_count = 0
     .num_of_choice = manufactor_choice_mode(VBA_mode).num_of_manufactor
     .can_mix = False
     .mix_count = 0
     .activate_find = False
    End With
   Next k
  Next j
 i = i + 1
 Loop
 
 
 'i = 2
 'type_count = 0
 'Do Until Workbooks(strfile).Sheets("type_information").Cells(i, 1) = 0
 ' type_count = type_count + 1
 ' With product_list(type_count, 0, 0)
 '  .type_code = Workbooks(strfile).Sheets("type_information").Cells(i, 1)
 '  .type_name = Workbooks(strfile).Sheets("type_information").Cells(i, 2)
 '  .expire_day = Workbooks(strfile).Sheets("type_information").Cells(i, 3)
 '  .mini_quantity = Workbooks(strfile).Sheets("type_information").Cells(i, 4)
 '
 '  .first_time = ""
 '  .first_row = 1
 '  .end_row = 1
 '  .total_availible_count = 0
 '  .num_of_choice = manufactor_choice_mode(VBA_mode).num_of_manufactor
 '  .can_mix = False
 '  .mix_count = 0
 '  .activate_find = False
 ' End With
 'i = i + 1
 'Loop
 
 Dim count As Integer
 
 i = 2
 Do Until Workbooks(strfile).Sheets("type_information").Cells(i, 1) = 0
  If Workbooks(strfile).Sheets("type_information").Cells(i, 5).MergeCells = True Then
   count = Workbooks(strfile).Sheets("type_information").Cells(i, 5).MergeArea.Rows.count
   'count = Cells(i, 2).MergeArea.columns.count
   For j = i To i + count - 1
    With product_list(j - 1, 0, 0)
     .can_mix = True
     .mix_count = count - 1
     
     k = i
     Do Until k = j
      .mix_type(k - i + 1) = k - 1
     k = k + 1
     Loop
     
     k = j + 1
     Do Until k > i + count - 1
      .mix_type(k - i + 1 - 1) = k - 1
     k = k + 1
     Loop
     
    End With
   Next j
   i = i + count - 1
  End If
 i = i + 1
 Loop
 
 Dim row As LongLong
 row = 1
 For i = 1 To type_count
  With product_list(i, 0, 0)
   Workbooks(strfile).Sheets("type_information").Cells(row, 19) = i
   Workbooks(strfile).Sheets("type_information").Cells(row, 20) = .type_code
   Workbooks(strfile).Sheets("type_information").Cells(row, 21) = .can_mix
   Workbooks(strfile).Sheets("type_information").Cells(row, 22) = .mix_count
   j = 1
   Do Until j > .mix_count
    Workbooks(strfile).Sheets("type_information").Cells(row + j, 23) = .mix_type(j)
    j = j + 1
   Loop
   row = row + .mix_count
  End With
  row = row + 1
 Next i
 
 
End Sub

Sub generate_list()
 boost
 save_file
 Workbooks(strfile).Sheets(1).Cells.Clear
 
 Dim i As LongLong
 Dim max_list As LongLong
 max_list = 150000
 Dim set_quantity As Integer
 set_quantity = 40
 
 
 define_info
 
 manufactor = 1
 With manufactor_row(manufactor)
  Workbooks(strfile).Sheets(1).Cells(1, .Tyre_Code) = "Tyre_Code"
  Workbooks(strfile).Sheets(1).Cells(1, .Tyre_ID) = "Tyre_ID"
  Workbooks(strfile).Sheets(1).Cells(1, .Quantity) = "Quantity"
  Workbooks(strfile).Sheets(1).Cells(1, .In_stock) = "In_stock"
  Workbooks(strfile).Sheets(1).Cells(1, .Quality) = "Quality"
  If manufactor = 3 Then
   Workbooks(strfile).Sheets(1).Cells(1, .Location) = ".Location"
  Else
   Workbooks(strfile).Sheets(1).Cells(1, .KMN_Set) = "KMN_Set"
  End If
 
  For i = 1 To max_list
   Workbooks(strfile).Sheets(1).Cells(i + 1, .Tyre_Code) = Chr(Int(3 * Rnd() + 70)) & Int(3 * Rnd() + 3) & Int(Int(4 * Rnd() + 1) * 20 + Int(9 * Rnd()) + 1)
   Workbooks(strfile).Sheets(1).Cells(i + 1, 12) = Workbooks(strfile).Sheets(1).Cells(i + 1, .Tyre_Code)
   
   Workbooks(strfile).Sheets(1).Cells(i + 1, .Tyre_ID) = Int(7 * Rnd() + 3) * 10 & Int(Int(4 * Rnd() + 1) * 20 + Int(7 * Rnd()) + 1) & Workbooks(strfile).Sheets(1).Cells(i + 1, .Tyre_Code) & CStr(max_list * 10 - i) & Int(8 * Rnd() + 1)
   Workbooks(strfile).Sheets(1).Cells(i + 1, .In_stock) = Int(2022 + Int(3 * Rnd())) & "/" & Int(12 * Rnd() + 1) & "/" & Int(28 * Rnd() + 1)
   Do Until DateDiff("d", Workbooks(strfile).Sheets(1).Cells(i + 1, .In_stock).Value, Date) >= 0
    Workbooks(strfile).Sheets(1).Cells(i + 1, .In_stock) = Int(2022 + Int(3 * Rnd())) & "/" & Int(12 * Rnd() + 1) & "/" & Int(28 * Rnd() + 1)
   Loop
   
   If Int(50 * Rnd()) = 0 Then 'quality fail
    Workbooks(strfile).Sheets(1).Cells(i + 1, .Quality) = "Fail"
   End If
   
   If manufactor = 3 Then
    Workbooks(strfile).Sheets(1).Cells(i + 1, .Location) = "Area-" & Int(100 - Int(13 * Rnd() + 1) * 6)
    Workbooks(strfile).Sheets(1).Cells(i + 1, .Quantity) = set_quantity
   Else
     If Int(3 * Rnd()) > 0 Then 'define K or M,N
      Workbooks(strfile).Sheets(1).Cells(i + 1, .KMN_Set) = "K"
      Workbooks(strfile).Sheets(1).Cells(i + 1, .Quantity) = set_quantity
      If Int(50 * Rnd()) = 0 Then 'randomly make K un set
       Workbooks(strfile).Sheets(1).Cells(i + 1, .Quantity) = Int(set_quantity / 2 * Rnd() + 1)
      End If
     Else
      Workbooks(strfile).Sheets(1).Cells(i + 1, .KMN_Set) = "M" 'split M, N
       Workbooks(strfile).Sheets(1).Cells(i + 1, .Quantity) = Int(set_quantity / 2 * Rnd() + 1)
      If Int(5 * Rnd()) > 0 Then 'randomly make M,N un pair
       i = i + 1
       For j = 1 To 100
        Workbooks(strfile).Sheets(1).Cells(i + 1, j) = Workbooks(strfile).Sheets(1).Cells(i, j)
       Next j
       Workbooks(strfile).Sheets(1).Cells(i + 1, .KMN_Set) = "N"
       Workbooks(strfile).Sheets(1).Cells(i + 1, .Quantity) = set_quantity - Workbooks(strfile).Sheets(1).Cells(i, .Quantity)
       Workbooks(strfile).Sheets(1).Cells(i + 1, .In_stock) = Workbooks(strfile).Sheets(1).Cells(i, .In_stock).Value
      Else
       If Int(3 * Rnd()) > 0 Then
        Workbooks(strfile).Sheets(1).Cells(i + 1, .KMN_Set) = "N"
       End If
      End If
     End If
   End If
  Next i
 End With
 Workbooks(strfile).Sheets(1).Columns("L:L").Sort Key1:=Range("L1"), Order1:=xlAscending, Header:=xlYes
   
 Do Until i = 2
  If Workbooks(strfile).Sheets(1).Cells(i, 12) = Workbooks(strfile).Sheets(1).Cells(i - 1, 12) Then
   Workbooks(strfile).Sheets(1).Cells(i, 12) = ""
  End If
 i = i - 1
 Loop
 Workbooks(strfile).Sheets(1).Columns("L:L").Sort Key1:=Range("L1"), Order1:=xlAscending, Header:=xlYes
 normal
 'find
End Sub

Sub find()
 
 save_file
 
 Workbooks(strfile).Sheets(2).Cells.Clear
 
 define_info
 
 Dim manufactor As Integer
 manufactor = 3
 
 For j = 1 To 8
  Workbooks(strfile).Sheets(2).Cells(1, j) = Workbooks(strfile).Sheets(1).Cells(1, j)
 Next j
 
 Dim target_code As String
 target_code = Workbooks(strfile).Sheets(1).Cells(10, 12)
 
 find_target manufactor, target_code, 2
 
 Workbooks(strfile).Sheets(2).Activate
 sorting_list manufactor
End Sub

Sub order_read()
 
 save_file
 define_info
 open_product_list
 
 boost
 
 
 order_count = 0
 Dim i, j, k As Integer
 
 
 j = 3
 Do Until Workbooks(strfile).Sheets("Shipping_plan").Cells(1, j) = ""
  i = 2
  Do Until Workbooks(strfile).Sheets("Shipping_plan").Cells(i, 2) = ""
   If Workbooks(strfile).Sheets("Shipping_plan").Cells(i, j) <> "" Then
    order_count = order_count + 1
    With order_plan(order_count)
     .ship_day = Workbooks(strfile).Sheets("Shipping_plan").Cells(1, j)
     .ship_destiny = Workbooks(strfile).Sheets("Shipping_plan").Cells(i, 2)
     .order_quantitiy = CLng(Workbooks(strfile).Sheets("Shipping_plan").Cells(i, j))
     .primary_type_code = Workbooks(strfile).Sheets("Shipping_plan").Cells(i, 1)
     .choice_type_count = 1
     For k = 1 To type_count
      If product_list(k, 0, 0).type_code = .primary_type_code Then
       .primary_type = k
       If product_list(k, 0, 0).activate_find = False Then
        product_list(k, 0, 0).activate_find = True
       End If
       k = type_count + 1
      End If
     Next k
    End With
   End If
  i = i + 1
  Loop
 j = j + 1
 Loop
 
 Workbooks(strfile).Sheets("Shipping_plan").Activate
 For i = 1 To order_count
  With order_plan(i)
   Workbooks(strfile).Sheets("Shipping_plan").Cells(i, 10) = i
   Workbooks(strfile).Sheets("Shipping_plan").Cells(i, 11) = .ship_day
   Workbooks(strfile).Sheets("Shipping_plan").Cells(i, 12) = .ship_destiny
   Workbooks(strfile).Sheets("Shipping_plan").Cells(i, 13) = .order_quantitiy
   Workbooks(strfile).Sheets("Shipping_plan").Cells(i, 14) = .primary_type_code
   Workbooks(strfile).Sheets("Shipping_plan").Cells(i, 15) = .primary_type
  End With
 Next i
 Dim m As Integer
 Workbooks(strfile).Sheets(2).Cells.Clear
 global_output_row = 2
 For k = 1 To type_count
  With product_list(k, 0, 0)
   Workbooks(strfile).Sheets("Shipping_plan").Cells(k, 20) = k
   Workbooks(strfile).Sheets("Shipping_plan").Cells(k, 21) = .type_code
   Workbooks(strfile).Sheets("Shipping_plan").Cells(k, 22) = .activate_find
   If .activate_find = True Then
    For m = 1 To manufactor_choice_mode(VBA_mode).num_of_manufactor
     Workbooks(strfile).Sheets(2).Cells(global_output_row, 1) = manufactor_choice_mode(VBA_mode).manufactor_produce_file(m)
     global_output_row = global_output_row + 1
     find_target manufactor_choice_mode(VBA_mode).manufactor_produce_excel(m), m, manufactor_choice_mode(VBA_mode).manufactor_code(m), k, global_output_row
     global_output_row = global_output_row + 2
     Next m
   End If
  End With
 Next k
 close_product_list
 normal
 
 
 For k = 1 To type_count
  With product_list(k, 0, 0)
   Workbooks(strfile).Sheets("Shipping_plan").Cells(k, 20) = k
   Workbooks(strfile).Sheets("Shipping_plan").Cells(k, 21) = .type_code
   Workbooks(strfile).Sheets("Shipping_plan").Cells(k, 22) = .activate_find
   If .activate_find = True Then
    For m = 1 To manufactor_choice_mode(VBA_mode).num_of_manufactor
     check_candidate m, manufactor_choice_mode(VBA_mode).manufactor_code(m), k
    Next m
   End If
  End With
 Next k
 
 
 
 Dim left_quantity As LongLong
 Dim manufactor_choice As Integer
 manufactor_choice = manufactor_choice_mode(VBA_mode).num_of_manufactor
 Dim manufactor_code As Integer
 manufactor_code = 3
 
 
 
 Workbooks(strfile).Sheets("工作表4").Cells.Clear
 global_output_row = 2
 For i = 1 To order_count
  With order_plan(i)
   Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, 1) = i
   Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, 2) = .ship_day
   Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, 3) = .ship_destiny
   Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, 4) = .order_quantitiy
   Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, 5) = .primary_type_code
   Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, 6) = .primary_type
  End With
  
  
  If product_list(order_plan(i).primary_type, manufactor_choice, 0).total_availible_count > order_plan(i).order_quantitiy Then
   Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, 16) = "有貨"
   Workbooks(strfile).Sheets("Shipping_plan").Cells(i, 16) = "有貨"
   
   left_quantity = order_plan(i).order_quantitiy
   global_output_row = global_output_row + 1
   
   For k = 1 To product_list(order_plan(i).primary_type, manufactor_choice, 0).num_of_choice
    With product_list(order_plan(i).primary_type, manufactor_choice, area_sort_sequence(order_plan(i).primary_type, manufactor_choice, k))
     If .total_availible_count > 0 Then
      For r = .first_availible_row To .end_row
       If left_quantity > 0 Then
        If Workbooks(strfile).Sheets(2).Cells(r, 15) = "" Then
         Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, col_offset + 13) = k
         Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, col_offset + 14) = area_sort_sequence(order_plan(i).primary_type, manufactor_choice, k)
         
         Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, col_offset + 15) = left_quantity
         left_quantity = left_quantity - Workbooks(strfile).Sheets(2).Cells(r, manufactor_row(manufactor_code).Quantity)
         Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, col_offset + 16) = left_quantity
         
         Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, col_offset + 18) = product_list(order_plan(i).primary_type, manufactor_choice, 0).total_availible_count
         product_list(order_plan(i).primary_type, manufactor_choice, 0).total_availible_count = product_list(order_plan(i).primary_type, manufactor_choice, 0).total_availible_count - Workbooks(strfile).Sheets(2).Cells(r, manufactor_row(manufactor_code).Quantity)
         Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, col_offset + 19) = product_list(order_plan(i).primary_type, manufactor_choice, 0).total_availible_count
         
         Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, col_offset + 21) = .total_availible_count
         .total_availible_count = .total_availible_count - Workbooks(strfile).Sheets(2).Cells(r, manufactor_row(manufactor_code).Quantity)
         Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, col_offset + 22) = .total_availible_count
         
         .first_availible_row = r
         
         For j = 1 To 10
          Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, j) = Workbooks(strfile).Sheets(2).Cells(r, j)
         Next j
         Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, manufactor_row(manufactor_code).In_stock) = Workbooks(strfile).Sheets(2).Cells(r, manufactor_row(manufactor_code).In_stock).Value
         Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, j) = Workbooks(strfile).Sheets(2).Cells(r, col_offset + 15)
         Workbooks(strfile).Sheets(2).Cells(r, col_offset + 15) = "出貨"
         global_output_row = global_output_row + 1
        End If
       Else
        r = .end_row + 1
       End If
      Next r
     End If
    End With
   Next k
  Else
   Workbooks(strfile).Sheets("工作表4").Cells(global_output_row, 16) = "沒貨"
   Workbooks(strfile).Sheets("Shipping_plan").Cells(i, 16) = "沒貨"
  End If
  
  global_output_row = global_output_row + 3
 Next i
 
 
 Workbooks(strfile).Sheets("工作表4").Activate
 Beep
End Sub

Sub boost()
' 暫停四個容易拖慢的 Excel 功能
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.DisplayAlerts = False
' 主要程式碼放在這裡

End Sub

Sub normal()
' 恢復四個容易拖慢的 Excel 功能
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

Sub save_file()
 strfile = Application.ActiveWorkbook.Name '本檔案的檔名
 str_OS = Mid(Application.ActiveWorkbook.Path, 1, 1)
 strpath = Application.ActiveWorkbook.Path & str_OS '"\" '本檔案在的路徑
 Workbooks(strfile).Sheets(1).Range("A:H").Clear
 Workbooks(strfile).Activate
 ActiveWorkbook.Save
 
 Select Case Mid(strfile, 10, 1)
  Case "O"
   VBA_mode = 1
   manufactor_choice_mode(VBA_mode).num_of_manufactor = 3
   manufactor_choice_mode(VBA_mode).manufactor_code(1) = 1 'Mic
   manufactor_choice_mode(VBA_mode).manufactor_produce_file(1) = "MICHELIN"
   manufactor_choice_mode(VBA_mode).manufactor_code(2) = 2 'Bris
   manufactor_choice_mode(VBA_mode).manufactor_produce_file(2) = "BRIDGESTONE"
   manufactor_choice_mode(VBA_mode).manufactor_code(3) = 3 'Per
   manufactor_choice_mode(VBA_mode).manufactor_produce_file(3) = "PIRELLI"
  Case "T"
   VBA_mode = 2
   manufactor_choice_mode(VBA_mode).num_of_manufactor = 1
   manufactor_choice_mode(VBA_mode).manufactor_code(1) = 3 'Per
   manufactor_choice_mode(VBA_mode).manufactor_produce_file(1) = "PIRELLI"
  Case Else
   VBA_mode = 1
 End Select
 
End Sub
Sub open_product_list()
 'save_file
 raw = 1
 With manufactor_choice_mode(VBA_mode)
  For i = 1 To .num_of_manufactor
   stritem = Dir(strpath & .manufactor_produce_file(i) & str_OS & "*.xlsx") 'find txt
   Do Until stritem = "" '將所有檔案條列出來
    Workbooks(strfile).Sheets("工作表1").Cells(raw, 1) = stritem '檔名
    .manufactor_produce_excel(i) = stritem '檔名
    Workbooks(strfile).Sheets("工作表1").Cells(raw, 3) = strpath & .manufactor_produce_file(i) & str_OS & .manufactor_produce_excel(i) '路徑加檔名
    Workbooks.Open FileName:=strpath & .manufactor_produce_file(i) & str_OS & .manufactor_produce_excel(i)
    stritem = Dir
    raw = raw + 1
   Loop
  Next i
 End With
End Sub

Sub close_product_list()
 'save_file
 raw = 1
 With manufactor_choice_mode(VBA_mode)
  For i = 1 To .num_of_manufactor
   Workbooks(.manufactor_produce_excel(i)).Activate
   ActiveWorkbook.Close
  Next i
 End With
End Sub
 
Sub sorting_list(manufactor As Integer, row_start As LongLong, row_end As LongLong)
 Dim str As String
 str = "A" & row_start & ":H" & row_end
 Workbooks(strfile).Sheets(2).Activate
 With manufactor_row(manufactor)
  Range(str).Sort Key1:=Range(.sorting_process(1)), Order1:=xlAscending, _
   Key2:=Range(.sorting_process(2)), Order2:=xlAscending, _
   Key3:=Range(.sorting_process(3)), Order3:=xlAscending, Header:=xlYes
 End With
End Sub

Sub find_target(manufactor_file As String, manufactor_choice As Integer, manufactor As Integer, target_code As Integer, output_row As LongLong)
 Workbooks(manufactor_file).Sheets(1).Activate
 Dim str As String
 str = Chr(64 + manufactor_row(manufactor).Tyre_Code) & ":" & Chr(64 + manufactor_row(manufactor).Tyre_Code)
 With Range(str)
  i = output_row
  For j = 1 To 8
   Workbooks(strfile).Sheets(2).Cells(i, j) = Workbooks(manufactor_file).Sheets(1).Cells(1, j)
  Next j
  i = i + 1
  ' 尋找資料含有「target_code」的儲存格
  
  Set Cell = .find(product_list(target_code, 0, 0).type_code, LookIn:=xlValues, LookAt:=xlPart)
  product_list(target_code, manufactor_choice, 0).first_row = i
 
  ' 若找到含有「target_code」的儲存格
  If Not Cell Is Nothing Then
   ' 儲存找到的第一個位置
   firstAddress = Cell.Address
   Do
    For j = 1 To 8
     Workbooks(strfile).Sheets(2).Cells(i, j) = Workbooks(manufactor_file).Sheets(1).Cells(Cell.row, j)
    Next j
    Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor).In_stock) = Workbooks(manufactor_file).Sheets(1).Cells(Cell.row, manufactor_row(manufactor).In_stock).Value
    ' 尋找下一個
    i = i + 1
    Set Cell = .FindNext(Cell)
   ' 若找到下一個不重複的儲存格，則繼續
   Loop While (Not Cell Is Nothing) And (Cell.Address <> firstAddress)
  End If
 End With
 product_list(target_code, manufactor_choice, 0).end_row = i - 1
 global_output_row = i
 Workbooks(strfile).Sheets(2).Cells(product_list(target_code, manufactor_choice, 0).first_row - 1, 10) = product_list(target_code, manufactor_choice, 0).first_row
 Workbooks(strfile).Sheets(2).Cells(product_list(target_code, manufactor_choice, 0).first_row - 1, 11) = product_list(target_code, manufactor_choice, 0).end_row
 
 'sorting_list manufactor, product_list(target_code, manufactor_choice, 0).first_row - 1, product_list(target_code, manufactor_choice, 0).end_row
End Sub

Sub check_candidate(manufactor_choice As Integer, manufactor_code As Integer, target_code As Integer)
 Workbooks(strfile).Sheets(2).Activate
 Workbooks(strfile).Sheets(2).Cells(product_list(target_code, manufactor_choice, 0).first_row, col_offset + 14) = manufactor_code
 Workbooks(strfile).Sheets(2).Cells(product_list(target_code, manufactor_choice, 0).first_row, col_offset + 15) = manufactor_row(manufactor_code).In_stock
 Dim find_MN As Boolean
 Dim checking As Boolean
 Dim str As String
 sorting_list manufactor_code, product_list(target_code, manufactor_choice, 0).first_row - 1, product_list(target_code, manufactor_choice, 0).end_row
 
 
 
 product_list(target_code, manufactor_choice, 0).total_availible_count = 0
 
 Select Case manufactor_code
  Case 1, 2
   With product_list(target_code, manufactor_choice, 0)
    .first_time = Workbooks(strfile).Sheets(2).Cells(.first_row, manufactor_row(manufactor_code).In_stock)
    For i = .first_row To .end_row
     checking = True
     If Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).Quality) <> "" Then
      Workbooks(strfile).Sheets(2).Cells(i, col_offset + 15) = "品質不佳"
      checking = flase
     Else
      If DateDiff("d", Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).In_stock), Date) > .expire_day Then
       Workbooks(strfile).Sheets(2).Cells(i, col_offset + 15) = "過期"
       checking = flase
      Else
       find_MN = False
       Select Case Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).KMN_Set)
        Case "K"
         find_MN = True
         If Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).Quantity) < .mini_quantity Then
          Workbooks(strfile).Sheets(2).Cells(i, col_offset + 15) = "K數量不足"
          checking = False
         End If
        Case "M"
         If Workbooks(strfile).Sheets(2).Cells(i - 1, manufactor_row(manufactor_code).KMN_Set) = "N" And Workbooks(strfile).Sheets(2).Cells(i - 1, manufactor_row(manufactor_code).Tyre_ID) = Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).Tyre_ID) Then
          find_MN = True
         Else
          If Workbooks(strfile).Sheets(2).Cells(i + 1, manufactor_row(manufactor_code).KMN_Set) = "N" And Workbooks(strfile).Sheets(2).Cells(i + 1, manufactor_row(manufactor_code).Tyre_ID) = Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).Tyre_ID) Then
           find_MN = True
          End If
         End If
        Case "N"
         If Workbooks(strfile).Sheets(2).Cells(i - 1, manufactor_row(manufactor_code).KMN_Set) = "M" And Workbooks(strfile).Sheets(2).Cells(i - 1, manufactor_row(manufactor_code).Tyre_ID) = Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).Tyre_ID) Then
          find_MN = True
         Else
          If Workbooks(strfile).Sheets(2).Cells(i + 1, manufactor_row(manufactor_code).KMN_Set) = "M" And Workbooks(strfile).Sheets(2).Cells(i + 1, manufactor_row(manufactor_code).Tyre_ID) = Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).Tyre_ID) Then
           find_MN = True
          End If
         End If
       End Select
       If find_MN = False Then
        Workbooks(strfile).Sheets(2).Cells(i, col_offset + 15) = "MN不成對"
        checking = False
       End If
      End If
     End If
     
     If checking = True Then
      If .total_availible_count = 0 Then
       .first_availible_row = i
       .first_time = Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).In_stock)
      End If
      .total_availible_count = .total_availible_count + Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).Quantity)
     End If
    Next i
    Workbooks(strfile).Sheets(2).Cells(.first_row - 1, col_offset + 13) = .total_availible_count
    Workbooks(strfile).Sheets(2).Cells(.first_row - 1, col_offset + 16) = .first_availible_row
    Workbooks(strfile).Sheets(2).Cells(.first_row - 1, col_offset + 17) = .first_time
   End With
   
  Case 3
   With product_list(target_code, manufactor_choice, 0)
    .num_of_choice = 1
    product_list(target_code, manufactor_choice, .num_of_choice).first_row = .first_row
    For i = .first_row To .end_row
     If Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).Location) <> Workbooks(strfile).Sheets(2).Cells(product_list(target_code, manufactor_choice, .num_of_choice).first_row, manufactor_row(manufactor_code).Location) Then
      product_list(target_code, manufactor_choice, .num_of_choice).end_row = i - 1
      .num_of_choice = .num_of_choice + 1
      product_list(target_code, manufactor_choice, .num_of_choice).first_row = i
     End If
     
     checking = True
     If Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).Quality) <> "" Then
      Workbooks(strfile).Sheets(2).Cells(i, col_offset + 15) = "品質不佳"
      checking = flase
     Else
      If DateDiff("d", Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).In_stock), Date) > .expire_day Then
        Workbooks(strfile).Sheets(2).Cells(i, col_offset + 15) = "過期"
        checking = False
      End If
     End If
     
     If checking = True Then
      If .total_availible_count = 0 Then
       .first_availible_row = i
       .first_time = Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).In_stock)
      End If
      .total_availible_count = .total_availible_count + Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).Quantity)
     
      If product_list(target_code, manufactor_choice, .num_of_choice).total_availible_count = 0 Then
       product_list(target_code, manufactor_choice, .num_of_choice).first_availible_row = i
       product_list(target_code, manufactor_choice, .num_of_choice).first_time = Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).In_stock)
      End If
      product_list(target_code, manufactor_choice, .num_of_choice).total_availible_count = product_list(target_code, manufactor_choice, .num_of_choice).total_availible_count + Workbooks(strfile).Sheets(2).Cells(i, manufactor_row(manufactor_code).Quantity)
     
     
     End If
    Next i
    product_list(target_code, manufactor_choice, .num_of_choice).end_row = i - 1
    
    
    Workbooks(strfile).Sheets(2).Cells(.first_row - 1, col_offset + 13) = .total_availible_count
    Workbooks(strfile).Sheets(2).Cells(.first_row - 1, col_offset + 16) = .first_availible_row
    Workbooks(strfile).Sheets(2).Cells(.first_row - 1, col_offset + 17) = .first_time
   
    
    
    Workbooks(strfile).Sheets(2).Cells(.first_row, col_offset + 19) = "area"
    Workbooks(strfile).Sheets(2).Cells(.first_row, col_offset + 20) = .num_of_choice
       
    For i = 1 To .num_of_choice
     Workbooks(strfile).Sheets(2).Cells(.first_row + i, col_offset + 25) = i
     Workbooks(strfile).Sheets(2).Cells(.first_row + i, col_offset + 26) = product_list(target_code, manufactor_choice, i).first_row
     Workbooks(strfile).Sheets(2).Cells(.first_row + i, col_offset + 27) = product_list(target_code, manufactor_choice, i).end_row
     
     Workbooks(strfile).Sheets(2).Cells(.first_row + i, col_offset + 28) = product_list(target_code, manufactor_choice, i).first_availible_row
     Workbooks(strfile).Sheets(2).Cells(.first_row + i, col_offset + 29) = product_list(target_code, manufactor_choice, i).first_time
     Workbooks(strfile).Sheets(2).Cells(.first_row + i, col_offset + 30) = product_list(target_code, manufactor_choice, i).total_availible_count
     
    Next i
    
    str = "Y" & .first_row & ":AE" & .end_row
    Workbooks(strfile).Sheets(2).Activate
    Range(str).Sort Key1:=Range("AC1"), Order1:=xlAscending, Header:=xlYes
    
    For i = 1 To .num_of_choice
     area_sort_sequence(target_code, manufactor_choice, i) = Workbooks(strfile).Sheets(2).Cells(.first_row + i, col_offset + 25)
     Workbooks(strfile).Sheets(2).Cells(.first_row + i, col_offset + 32) = area_sort_sequence(target_code, manufactor_choice, i)
    Next i
    
   End With
  Case Else
 End Select
 
End Sub

VBA-ch4-20240213-perri

標題6

first $$x = {-b \pm \sqrt{b^2-4ac} \over 2a}.$$