返回列表 上一主題 發帖

一個資料輸入問題

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
1# 跳轉到 »
發表於 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
複製代碼
活頁簿1-a.zip (17.76 KB)

TOP

        靜思自在 : 人生最大的成就是從失敗中站起來。
返回列表 上一主題