以下是我請AI做的動作，AI整理我要的動作如下，問了ChatGPT、gemini、Grok，之前詢問過的簡單版前身，是gemini勝出，這次Grok勝出，但Gpt修改錯誤後，也可以運行。
 |
| 廢品轉換的問題資料 |
 |
| 廢品轉換的結果 |
✅ 第一個動作：
-
找出料號為「3開頭」的第一筆出庫（數量為負數）資料。
-
根據該出庫的「單號」，列出料號為「1開頭」的轉換庫存資料（相同單號）。
✅ 第二個動作：
針對每一筆第一動作中出現於 J欄的料號，找出該料號在該日期以後的**第一筆出庫（負數）**紀錄，並記錄下來。
Sub 出庫轉換追蹤_GPT版()
Dim wsA As Worksheet, wsB As Worksheet
Dim lastRowA As Long, outRow As Long
Dim dictFirstOut As Object, dictTransfer As Object, dictSecondOut As Object
Dim i As Long, key As String
Dim partNo As String, qty As Double, docDate As Date, docNo As String
Dim item As Variant
Dim cellData As Variant
Set wsA = ThisWorkbook.Sheets("A")
Set wsB = ThisWorkbook.Sheets("B")
wsB.Cells.ClearContents
lastRowA = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row
outRow = 2 '從第2列開始輸出
Set dictFirstOut = CreateObject("Scripting.Dictionary")
Set dictTransfer = CreateObject("Scripting.Dictionary")
Set dictSecondOut = CreateObject("Scripting.Dictionary")
' ========== 第一個動作：找出料號3開頭第一筆出庫 ==========
For i = 2 To lastRowA
partNo = Trim(wsA.Cells(i, "A").Value)
qty = wsA.Cells(i, "H").Value
docNo = wsA.Cells(i, "G").Value
If Left(partNo, 1) = "3" And qty < 0 Then
If Not dictFirstOut.exists(partNo) Then
dictFirstOut.Add partNo, i
End If
End If
Next i
' 輸出料號3開頭第一筆出庫
wsB.Cells(1, 1).Resize(1, 9).Value = Array("料號", "品名", "規格", "倉庫", "儲位", "單據日期", "單號", "數量", "單位")
wsB.Cells(1, 10).Resize(1, 9).Value = Array("轉入料號", "品名", "規格", "倉庫", "儲位", "單據日期", "單號", "數量", "單位")
For Each key In dictFirstOut.Keys
i = dictFirstOut(key)
docNo = wsA.Cells(i, "G").Value
docDate = wsA.Cells(i, "F").Value
' 輸出出庫資料（3開頭）
For j = 1 To 9
wsB.Cells(outRow, j).Value = wsA.Cells(i, j).Value
Next j
' ========== 取得轉換庫存（同單號且料號為1開頭） ==========
For k = 2 To lastRowA
If wsA.Cells(k, "G").Value = docNo And Left(wsA.Cells(k, "A").Value, 1) = "1" Then
For j = 1 To 9
wsB.Cells(outRow, 9 + j).Value = wsA.Cells(k, j).Value
Next j
' 儲存料號及日期，用於第二個動作
dictTransfer.Add outRow, Array(wsA.Cells(k, "A").Value, docDate)
Exit For '只取一筆轉入資料
End If
Next k
outRow = outRow + 1
Next key
' ========== 第二個動作：找出J欄料號對應日期後第一筆出庫 ==========
wsB.Cells(1, 19).Resize(1, 9).Value = Array("後續出庫_料號", "品名", "規格", "倉庫", "儲位", "單據日期", "單號", "數量", "單位")
For Each key In dictTransfer.Keys
partNo = dictTransfer(key)(0)
docDate = dictTransfer(key)(1)
found = False
For i = 2 To lastRowA
If wsA.Cells(i, "A").Value = partNo And wsA.Cells(i, "H").Value < 0 Then
If wsA.Cells(i, "F").Value > docDate Then
' 找到符合條件的出庫
For j = 1 To 9
wsB.Cells(key, 18 + j).Value = wsA.Cells(i, j).Value
Next j
Exit For
End If
End If
Next i
Next key
MsgBox "處理完成！"
End Sub
---------------------以下為grok版，代碼行數差不多
Option Explicit
Sub ProcessInventory_grok()
Dim wsA As Worksheet, wsB As Worksheet
Dim lastRowA As Long, lastRowB As Long
Dim i As Long, j As Long, outputRow As Long
Dim dict As Object, key As Variant
Dim firstOut As Object, transferOut As Object
Dim found As Boolean
' 設定工作表
Set wsA = Sheets("A") ' 庫存明細帳
Set wsB = Sheets("B") ' 整理結果
lastRowA = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row
' 清空 SheetB 內容（保留標題）
wsB.Cells.ClearContents
wsB.Range("A1:I1").Value = Array("料號", "品名", "規格", "倉庫", "儲位", "單據日期", "單號", "數量", "單位")
wsB.Range("J1:R1").Value = Array("料號", "品名", "規格", "倉庫", "儲位", "單據日期", "單號", "數量", "單位")
wsB.Range("S1:AA1").Value = Array("料號", "品名", "規格", "倉庫", "儲位", "單據日期", "單號", "數量", "單位")
' 使用 Dictionary 儲存料號以 3 開頭的第一筆出庫記錄
Set dict = CreateObject("Scripting.Dictionary")
Set firstOut = CreateObject("Scripting.Dictionary")
' 第一個動作：找出料號以 3 開頭的第一筆出庫記錄
For i = 2 To lastRowA
If Left(wsA.Cells(i, 1).Value, 1) = "3" And wsA.Cells(i, 8).Value < 0 Then
Dim partNo As String
partNo = wsA.Cells(i, 1).Value
If Not firstOut.exists(partNo) Then
firstOut.Add partNo, i
Else
' 比較單據日期，保留最早的
If wsA.Cells(i, 6).Value < wsA.Cells(firstOut(partNo), 6).Value Then
firstOut(partNo) = i
End If
End If
End If
Next i
' 將結果寫入 SheetB
outputRow = 2
For Each key In firstOut.Keys
i = firstOut(key)
' 寫入 A:I 欄（料號以 3 開頭的第一筆出庫）
wsB.Range("A" & outputRow & ":I" & outputRow).Value = _
wsA.Range("A" & i & ":I" & i).Value
' 找出同單號下料號以 1 開頭的記錄
Dim docNo As String
docNo = wsA.Cells(i, 7).Value
found = False
For j = 2 To lastRowA
If wsA.Cells(j, 7).Value = docNo And Left(wsA.Cells(j, 1).Value, 1) = "1" Then
' 寫入 J:R 欄（轉換庫存訊息）
wsB.Range("J" & outputRow & ":R" & outputRow).Value = _
wsA.Range("A" & j & ":I" & j).Value
found = True
Exit For ' 假設每單號只有一筆料號以 1 開頭的記錄
End If
Next j
If found Then outputRow = outputRow + 1
Next key
' 第二個動作：比對 J 欄料號，找出日期之後的第一筆出庫
Set transferOut = CreateObject("Scripting.Dictionary")
lastRowB = wsB.Cells(wsB.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRowB
partNo = wsB.Cells(i, 10).Value ' J 欄料號
If partNo <> "" And Left(partNo, 1) = "1" Then
Dim refDate As Date
refDate = wsB.Cells(i, 15).Value ' O 欄單據日期
Dim earliestRow As Long, earliestDate As Date
earliestRow = 0
earliestDate = DateSerial(9999, 12, 31) ' 初始為遠未來日期
' 找出該料號在參考日期之後的第一筆出庫
For j = 2 To lastRowA
If wsA.Cells(j, 1).Value = partNo And wsA.Cells(j, 8).Value < 0 And _
wsA.Cells(j, 6).Value > refDate Then
If wsA.Cells(j, 6).Value < earliestDate Then
earliestDate = wsA.Cells(j, 6).Value
earliestRow = j
End If
End If
Next j
' 寫入 S:AA 欄
If earliestRow > 0 Then
wsB.Range("S" & i & ":AA" & i).Value = _
wsA.Range("A" & earliestRow & ":I" & earliestRow).Value
End If
End If
Next i
MsgBox "處理完成！請檢查 SheetB 的結果。", vbInformation
End Sub
