Sub 預約更新()
Dim Arr, xD, i&, T$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([說明!R1], [說明!i65536].End(xlUp))
For i = 3 To UBound(Arr)
If Arr(i, 1) = "" Or IsDate(Arr(i, 4)) Then
T = Arr(i, 1) & "|" & Arr(i, 4)
xD(T) = xD(T) + Val(Arr(i, 7)) '同日同號不只一筆,累加
xD(T & "/m") = "#0000" & Arr(i, 5) '取板編號
End If
Next i
Arr = Range([預約!G1], [預約!A65536].End(xlUp))
For i = 2 To UBound(Arr)
T = Arr(i, 2) & "|" & Arr(i, 1)
If xD.Exists(T) Then
Arr(i, 3) = xD(T)
Arr(i, 7) = xD(T & "/m")
End If
Next i
[預約!A1].Resize(UBound(Arr), 7) = Arr
End Sub
Sub 預約更新()
Dim Arr, xD, i&, T$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([說明!R1], [說明!i65536].End(xlUp))
For i = 3 To UBound(Arr)
If Arr(i, 1) <> "" And IsDate(Arr(i, 4)) Then
T = Arr(i, 1) & "|" & Arr(i, 4) & "#0000" & Arr(i, 5)
xD(T) = xD(T) + Val(Arr(i, 7))
End If
Next i
Arr = Range([預約!G1], [預約!A65536].End(xlUp))
For i = 2 To UBound(Arr)
T = Arr(i, 2) & "|" & Arr(i, 1) & Arr(i, 7)
If xD.Exists(T) Then Arr(i, 3) = xD(T)
Next i
[預約!A1].Resize(UBound(Arr), 7) = Arr
End Sub作者: PJChen 時間: 2021-1-17 18:03
For X = 2 To UBound(Arr) '在陣列裡的第2列開始到最後一列
A = Arr(X, 1) & "-" & Arr(X, 4) '說明文字 帳號串聯日期
For Y = X To UBound(Brr) '在陣列裡的第2列開始到最後一列
B = Brr(Y, 2) & "-" & Brr(Y, 1) '預約文字 帳號串聯日期
If A = B And Brr(Y, 3) = "" Then K = 0 '如果說明文字與預約文字相同 且預約X列位的第3欄位沒有內容 K就等於0 表示沒有被比對過
If A = B And Arr(X, 4) <> "" And K <> 1 Then '如果說明文字的與預約文字相同 且說明X列位的第4欄位有內容 且K不等於1 表示沒有被比對過
K = 1 '表示已經被比對過
Cells(Y, 3) = Arr(X, 7) '把說明的預約板數放到預約工作表的單項取板欄位
Cells(Y, 7) = "#0000" & Arr(X, 5) '把說明的 "#0000"串聯取板編號 放到預約工作表的取板編號欄位
Exit For '跳到下一個迴圈
End If
Next Y
Next X
'D:F欄的公式值化 是因為 Brr = [預約!A1].CurrentRegion 的關係 所有內容放到陣列 或改成特定位置
'[預約!A1].Resize(UBound(Brr, 1), UBound(Brr, 2)) = Brr 因為沒有在陣列裡比對所以不需要
Brr指的是預約工作表比對後的內容
其實用字典方法會更好 但小弟還在學習中不太理解...有空還是會來看看大大們怎麼寫.順便學習^^"
Application.ScreenUpdating = True '開啟更新畫面
End Sub作者: PJChen 時間: 2021-1-22 23:00
