- 帖子
- 1567
- 主題
- 40
- 精華
- 0
- 積分
- 1591
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2026-2-2
|
本帖最後由 Andy2483 於 2024-2-29 10:55 編輯
謝謝論壇,謝謝 准提部林前輩指導,謝謝前輩發話題一起學習
建議前輩在得到協助代碼後試著自己逐列了解其意義,必要時自己註解,不了解的部分查論壇,或它網,或問代碼細節
以下是 准提部林前輩的方案
Sub Test_A1()
Dim Arr, Brr, xD, xZ As Range, xF As Range, T$, R&, C&, i&
T = [Invoice!G5] '單號
If Not T Like "INV########" Then Exit Sub '單號不符合INV+8位日期..跳出
Set xZ = [Data!a1].Cells(1, Columns.Count).End(1) '找data第一行最後非空
Set xF = [Data!1:1].Find(T, Lookat:=xlWhole) '找單號在data的欄位
If xF Is Nothing Then Set xZ = xZ(1, 2): Set xF = xZ '若單號不存在, 增加一欄
Set xD = CreateObject("Scripting.Dictionary")
'-------------------------------
Arr = Range([Data!c1], [Data!a1].Cells(Rows.Count, 1).End(3))
Arr(1, 1) = T '將Arr第一欄首格放入"單號"
For i = 2 To UBound(Arr)
T = Arr(i, 1) & "\" & Arr(i, 2) & "\" & Arr(i, 3)
xD(T) = i '字典記憶行位置
Arr(i, 1) = 0 '將Arr第一欄放入0, 以備填入數量
Next i
'----------------------------
Brr = Range([Invoice!h1], [Invoice!a1].Cells(Rows.Count, 1).End(3))
For i = 2 To UBound(Brr)
R = xD(Brr(i, 3) & "\" & Brr(i, 4) & "\" & Brr(i, 5))
If R > 0 Then Arr(R, 1) = Arr(R, 1) + Brr(i, 6)
Next i
'----------------------------
xF.Resize(UBound(Arr)).Value = Arr
With Range([Data!F1], xZ).Resize(UBound(Arr)) '單號欄格式
.ColumnWidth = 15 '統一欄寬
.Borders.LineStyle = 1 '加框
.HorizontalAlignment = xlCenter '縱置中
.VerticalAlignment = xlCenter '橫置中
End With
[Data!e2].Resize(UBound(Arr) - 1) = "=D2-SUM(F2:" & xZ(2).Address(0, 0) & ")" 'E欄"結餘"公式(隨欄數變化)..刪去欄也可正確計算
End Sub |
|
發表於 2024-2-27 16:32
| 
