- 帖子
- 824
- 主題
- 6
- 精華
- 0
- 積分
- 904
- 點名
- 0
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2023-12-24
|
2#
發表於 2013-10-8 23:29
| 只看該作者
本帖最後由 luhpro 於 2013-10-8 23:33 編輯
回復 1# 周大偉
ModuleThisWorkbook- Private Sub Workbook_Open()
- Dim lTRow&
- Dim shSou As Worksheet
-
- Set shSou = Sheets("工作表1")
- Set dNum = CreateObject("Scripting.Dictionary")
-
- With Sheets("工作表2")
- lTRow = 2
- Do While .Cells(lTRow, 1) <> ""
- dNum(CStr(.Cells(lTRow, 1))) = dNum(CStr(.Cells(lTRow, 1))) + .Cells(lTRow, 5)
- .Cells(lTRow, 9) = dNum(CStr(.Cells(lTRow, 1)))
- lTRow = lTRow + 1
- Loop
- End With
- End Sub
- Private Sub CommandButton1_Click()
- Dim lSRow&, lTRow&, lTRows&
- Dim shSou As Worksheet
-
- Set shSou = Sheets("工作表1")
- With Sheets("工作表2")
- lTRows = .Cells(Rows.Count, 1).End(xlUp).Row
- For lSRow = 15 To 34
- lTRow = lTRows + lSRow - 14
- .Cells(lTRow, 1) = shSou.Cells(lSRow, 4)
- .Cells(lTRow, 2) = shSou.Cells(lSRow, 6)
- .Cells(lTRow, 3) = shSou.Cells(lSRow, 8)
- .Cells(lTRow, 4) = shSou.Cells(lSRow, 10)
- .Cells(lTRow, 5) = shSou.Cells(lSRow, 11)
- dNum(CStr(.Cells(lTRow, 1))) = dNum(CStr(.Cells(lTRow, 1))) + .Cells(lTRow, 5)
- .Cells(lTRow, 9) = dNum(CStr(.Cells(lTRow, 1)))
- shSou.Cells(lSRow, 13) = dNum(CStr(.Cells(lTRow, 1)))
- Next lSRow
- End With
 活頁簿1-a.zip (17.76 KB)
|
|
