Sub ex()
Dim Arr As Variant, d As Object, a As Variant, b As Variant, X%, Y%
Set d = CreateObject("Scripting.Dictionary")
With Workbooks.Open(ThisWorkbook.Path & "\" & "包材報表.xlsx").Sheets("包材")
Set Arr = .Range(.[b5], .[P7]) '資料範圍
End With
For X = 1 To Arr.Rows.Count
For Y = 4 To Arr.Columns.Count
If Arr(X, Y).HasFormula Then '判斷儲存格是否為公式
If Arr(X, Y).FormulaR1C1Local Like "*+*" Then '判斷公式內是否為"+"
d(Arr(X, 1) & Arr(X, Y).Offset(-3 - X)) = Split(Arr(X, Y).FormulaR1C1Local, "+")(1) '資料寫入字典
Else '判斷公式內為"-"
d(Arr(X, 1) & Arr(X, Y).Offset(-3 - X)) = "-" & Split(Arr(X, Y).FormulaR1C1Local, "-")(1) '資料寫入字典
End If
End If
Next
Next
Workbooks("包材報表.xlsx").Close False
For Each a In Range([C16], [C18]) '包材區間
For Each b In Range([F2], [F2].End(2)) '日期區間
If d.exists(a & b) Then Cells(a.Row, b.Column) = d(a & b) '將字典資料寫入相符的儲存格
Next
Next
Set d = Nothing
End Sub作者: PJChen 時間: 2021-4-1 23:44
回復 12#軒云熊
謝謝熊大,
稍微修改後,截取資料正確,請問:
1) 我不想關閉來源檔Workbooks("包材報表.xlsx").Close False,但會無法執行,且每執行一次就增加二欄,原因是什麼？
2) 是否因為這個For I = 1 To 2: Columns(4).Insert , 2: Next I,為什需要增加2欄呢?
3) 我沒看過這種寫法,範圍為何是倒著寫呢?Arr = Range("AK11:C2").FormulaR1C1Local
4) 能否幫忙註解程式的意思?
感激不盡....
Range("E16:AJ25").ClearContents
Workbooks.Open ThisWorkbook.Path & "\" & "包材報表.xlsx"
For I = 1 To 2: Columns(4).Insert , 2: Next I
Arr = Range("AK11:C2").FormulaR1C1Local
Workbooks("包材報表.xlsx").Close False
Brr = Range("B16:AJ25")
For X = 1 To UBound(Arr, 1)
For Y = 1 To UBound(Brr, 1)
If Trim(Arr(X, 1)) = Trim(Brr(Y, 1)) Then
For E = 1 To UBound(Arr, 2)
If Arr(X, E) Like "*-*" Then
G = Split(Arr(X, E), "-")(1)
Brr(Y, E) = "=-" & G
ElseIf Arr(X, E) Like "*+*" Then
G = Split(Arr(X, E), "+")(1)
Brr(Y, E) = "=+" & G
End If
Next E
End If
Next Y
Next X
