跨檔案多重條件加總

1^# 跳轉到 »

發表於 2013-8-13 00:06 | 顯示全部帖子

回復 1# hong912
本來用 xlsx 格式檔案實做出來了,
但要上傳代碼前卻突然發現檔案裡的程式碼全部看不見(甚至連檔案都變唯讀)了,
所以只能改用自己版本的 xls 檔案格式重做後上傳囉:

Private Sub cbCal_Click()
Dim lRows As Long, lRow As Long
Dim wbData As Workbook
Dim dTar
Set dTar = CreateObject("Scripting.Dictionary")
Set wbData = Workbooks.Open(Me.Parent.Path & "\積分表.xlsx", , True)
With wbData.Application.Sheets("工作表1")
lRows = .Cells(Rows.Count, 1).End(xlUp).Row
For lRow = 3 To lRows
dTar(CStr(.Cells(lRow, 1) & "-" & .Cells(lRow, 3))) = dTar(CStr(.Cells(lRow, 1) & "-" & .Cells(lRow, 3))) + CLng(.Cells(lRow, 7))
Next lRow
End With
With Me
lRows = .Cells(Rows.Count, 1).End(xlUp).Row
For lRow = 3 To lRows
.Cells(lRow, 6) = dTar(CStr(.Cells(lRow, 1) & "-" & .Cells(lRow, 2)))
Next lRow
End With
wbData.Close
End Sub

複製代碼

計算表-A.zip (11.09 KB)

靜思自在 : 愛不是要求對方，而是要由自身的付出。