麻辣家族討論版版 » Excel程式區 » 一個資料輸入問題

返回列表下一主題上一主題發帖

一個資料輸入問題

中學生 Rank: 2

帖子: 250
主題: 59
精華: 0
積分: 313
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 澳門
註冊時間: 2010-9-11
最後登錄: 2020-1-6

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2013-10-5 18:58 | 只看該作者

一個資料輸入問題

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

活頁簿1.rar (9.92 KB)

樓主熱帖

收藏

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 16
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2024-11-14

2^#

發表於 2013-10-8 23:29 | 只看該作者

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

回復 1# 周大偉
Module

Public dNum

複製代碼

ThisWorkbook

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

複製代碼

Sheets("工作表1")

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)

中學生 Rank: 2

帖子: 250
主題: 59
精華: 0
積分: 313
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 澳門
註冊時間: 2010-9-11
最後登錄: 2020-1-6

3^#

發表於 2013-10-9 08:31 | 只看該作者

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

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

靜思自在 : 人事的艱難與琢磨，就是一種考驗。

返回列表下一主題上一主題