- 帖子
- 234
- 主題
- 19
- 精華
- 0
- 積分
- 276
- 點名
- 0
- 作業系統
- Windows XP
- 軟體版本
- office 2003
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2013-1-7
- 最後登錄
- 2021-10-7
|
回復 2# PJChen
巨集請放於"包材驗算"檔案
資料位置以原附件設定,如有不同請自行調整
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 |
|
發表於 2021-3-31 10:30
| 
