標題: 一個資料輸入問題 [打印本頁]

---

作者: 周大偉    時間: 2013-10-5 18:58     標題: 一個資料輸入問題

大大們, 安好
小弟有一資料輸入問題求助, 請大大們協助, 附傳檔案, 內有說明, 先行謝過大大們.
[attach]16252[/attach]

---

作者: luhpro    時間: 2013-10-8 23:29

本帖最後由 luhpro 於 2013-10-8 23:33 編輯

回復 1# 周大偉
Module

1. Public dNum

複製代碼

ThisWorkbook

1. Private Sub Workbook_Open()
   
2.   Dim lTRow&
   
3.   Dim shSou As Worksheet
   
4.   
   
5.   Set shSou = Sheets("工作表1")
   
6.   Set dNum = CreateObject("Scripting.Dictionary")
   
7.   
   
8.   With Sheets("工作表2")
   
9.     lTRow = 2
   
10.     Do While .Cells(lTRow, 1) <> ""
    
11.       dNum(CStr(.Cells(lTRow, 1))) = dNum(CStr(.Cells(lTRow, 1))) + .Cells(lTRow, 5)
    
12.       .Cells(lTRow, 9) = dNum(CStr(.Cells(lTRow, 1)))
    
13.       lTRow = lTRow + 1
    
14.     Loop
    
15.   End With
    
16. End Sub

複製代碼

Sheets("工作表1")

1. Private Sub CommandButton1_Click()
   
2.   Dim lSRow&, lTRow&, lTRows&
   
3.   Dim shSou As Worksheet
   
4.   
   
5.   Set shSou = Sheets("工作表1")
   
6.   With Sheets("工作表2")
   
7.     lTRows = .Cells(Rows.Count, 1).End(xlUp).Row
   
8.     For lSRow = 15 To 34
   
9.       lTRow = lTRows + lSRow - 14
   
10.       .Cells(lTRow, 1) = shSou.Cells(lSRow, 4)
    
11.       .Cells(lTRow, 2) = shSou.Cells(lSRow, 6)
    
12.       .Cells(lTRow, 3) = shSou.Cells(lSRow, 8)
    
13.       .Cells(lTRow, 4) = shSou.Cells(lSRow, 10)
    
14.       .Cells(lTRow, 5) = shSou.Cells(lSRow, 11)
    
15.       dNum(CStr(.Cells(lTRow, 1))) = dNum(CStr(.Cells(lTRow, 1))) + .Cells(lTRow, 5)
    
16.       .Cells(lTRow, 9) = dNum(CStr(.Cells(lTRow, 1)))
    
17.       shSou.Cells(lSRow, 13) = dNum(CStr(.Cells(lTRow, 1)))
    
18.     Next lSRow
    
19.   End With

複製代碼

[attach]16274[/attach]

---

作者: 周大偉    時間: 2013-10-9 08:31

本帖最後由 周大偉 於 2013-10-9 08:34 編輯

回復 2# luhpro
真心感謝大大, 已試用, 再度謝謝, 祝願快樂..

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)