帖子: 15
主題: 5
精華: 0
積分: 20
點名: 0
作業系統: WINDOWS
軟體版本: XP
閱讀權限: 10
性別: 男
註冊時間: 2011-4-26
最後登錄: 2011-5-13

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2011-5-4 17:17 | 只看該作者

[發問] 如何依輸入之筆數及數量 ,以巨集復製資料

本帖最後由 melvinhsu1105 於 2011-5-4 17:45 編輯

請問, 各位先進及先進,

在excel 一個work sheets 如有多列不同資料, 而能否代為教導或寫個vba 開一巨集視窗,

假設我要第1 及第2 及第5列資料, 分別要復制成2筆 / 3筆/ 2筆,, 在視窗輸入對應列數及筆數, 而在另一個worksheets 自動產生.

如有不清楚之處,再請各位先進,板主說明.

感謝, 各位.

ps. 因小弟沒權限下載檔, 故, 可否貼上程式碼, 或email 給小弟. : [email protected]

樓主熱帖

melvinhsu1105

小學生 Rank: 1

帖子: 15
主題: 5
精華: 0
積分: 20
點名: 0
作業系統: WINDOWS
軟體版本: XP
閱讀權限: 10
性別: 男
註冊時間: 2011-4-26
最後登錄: 2011-5-13

7^#

發表於 2011-5-6 10:02 | 只看該作者

回復 5# Hsieh

請問老師, 有可能將選擇的復製之資料, 丟入其它檔名內的worksheets .

ex. 如原檔的檔名叫: 學生名條 (sheet 1) , 在學生名條挑選後的資料, 再貼上至檔名叫 : 列印清單的 (sheet 1)

請不吝指教.

TOP

melvinhsu1105

小學生 Rank: 1

帖子: 15
主題: 5
精華: 0
積分: 20
點名: 0
作業系統: WINDOWS
軟體版本: XP
閱讀權限: 10
性別: 男
註冊時間: 2011-4-26
最後登錄: 2011-5-13

6^#

發表於 2011-5-5 11:52 | 只看該作者

回復 5# Hsieh

老師, 謝謝您. 請問你有開班授課嗎. 不知有沒有機會向您學習有關VBA的語法.

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 256
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-26

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

5^#

發表於 2011-5-4 18:53 | 只看該作者

回復 4# melvinhsu1105

學海無涯_不恥下問

TOP

melvinhsu1105

小學生 Rank: 1

帖子: 15
主題: 5
精華: 0
積分: 20
點名: 0
作業系統: WINDOWS
軟體版本: XP
閱讀權限: 10
性別: 男
註冊時間: 2011-4-26
最後登錄: 2011-5-13

4^#

發表於 2011-5-4 18:21 | 只看該作者

回復 3# Hsieh

老師,

不好意思, 小弟,太久沒用了, 程式碼怎麼用到表單按鍵己不太熟悉. 可否代為套好. 寄至我的信箱. 不好意思.

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 256
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-26

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

3^#

發表於 2011-5-4 17:57 | 只看該作者

回復 1# melvinhsu1105

Private Sub CommandButton1_Click()
Dim Ar()
d = InputBox("輸入列位", , 2)
k = InputBox("輸入對應數量", , 2)
Do Until d = "" Or k = ""
ReDim Preserve Ar(s)
Ar(s) = Array(d, k)
s = s + 1
d = InputBox("輸入列位", , 2)
k = InputBox("輸入對應數量", 2)
Loop
For i = 0 To UBound(Ar)
For j = 1 To Ar(i)(1)
r = IIf(Application.CountA(Sheet2.Columns("A")) = 0, 1, Sheet2.[A65536].End(xlUp).Row + 1)
Rows(Ar(i)(0)).Copy Sheet2.Cells(r, 1)
Next
Next
End Sub