12
返回列表 上一主題 發帖

[發問] 在每列第1欄輸入筆數, 依筆數覆製每列訊息後另存成一個新檔

melvinhsu1105

帖子
15 
主題
5 
精華
0 
積分
20 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
10 
性別
男 
註冊時間
2011-4-26 
最後登錄
2011-5-13 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2011-5-10 21:43 | 只看該作者

[發問] 在每列第1欄輸入筆數, 依筆數覆製每列訊息後另存成一個新檔

本帖最後由 melvinhsu1105 於 2011-5-12 00:20 編輯

再請問, 各位先進及老師,

小弟, 希望在一資料表內的第1欄, 輸入需覆製的筆數, 而後在執行巨集, 依每列第1欄的筆數,覆製後, 再另存(開)一新檔, 不知應如何製作.



收藏 分享

melvinhsu1105

帖子
15 
主題
5 
精華
0 
積分
20 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
10 
性別
男 
註冊時間
2011-4-26 
最後登錄
2011-5-13 
12#
發表於 2011-5-12 11:15 | 只看該作者
本帖最後由 GBKEE 於 2011-5-12 11:44 編輯

回復 10# luhpro


的確.是醬子的. 我昨天沒用好. 感謝. 先進.

回復 11# Hsieh


    老師, 抱歉我昨天沒用好, 故未能成功. 再次謝謝您的協助.

TOP

Hsieh

帖子
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兔年全勤獎章
11#
發表於 2011-5-12 07:22 | 只看該作者
回復 9# melvinhsu1105


    上傳你作的檔案看看
學海無涯_不恥下問

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
10#
發表於 2011-5-12 00:48 | 只看該作者
本帖最後由 luhpro 於 2011-5-12 00:49 編輯

回復 9# melvinhsu1105

可能是你程式碼放錯地方了.
Sub ex() 與最底下的 End Sub 都不要 Copy,
只 Copy 中間的程式碼就好,
然後點兩下 CommandButton1 它會自動建立 :

Private Sub CommandButton1_Click()

End Sub

把 Copy 的程式碼放在上述兩行 Sub 敘述的中間即可.

TOP

melvinhsu1105

帖子
15 
主題
5 
精華
0 
積分
20 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
10 
性別
男 
註冊時間
2011-4-26 
最後登錄
2011-5-13 
9#
發表於 2011-5-12 00:22 | 只看該作者
回復 8# Hsieh


    老師, 謝謝你的回應.

而小弟我在直接覆製上後,  執行, 未有任何作用, 原因為何, ? 已在補上照.

多有勞煩.

TOP

Hsieh

帖子
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兔年全勤獎章
8#
發表於 2011-5-11 14:17 | 只看該作者
回復 7# melvinhsu1105
  1. Sub ex()
  2. Dim Ar()
  3. With ActiveSheet
  4. a = .Range("A1").CurrentRegion
  5. ReDim Preserve Ar(s)
  6. Ar(s) = Application.Index(a, 1)
  7. s = s + 1
  8. For i = 2 To UBound(a, 1)
  9.    For j = 1 To a(i, 1)
  10.       ReDim Preserve Ar(s)
  11.       Ar(s) = Application.Index(a, i)
  12.       s = s + 1
  13.    Next
  14. Next
  15. End With
  16. With Workbooks.Add
  17.   .Sheets(1).[A1].Resize(s, UBound(a, 2)) = Application.Transpose(Application.Transpose(Ar))
  18.   .Sheets(1).Columns("A").Delete
  19.   '.SaveAs "D:\Test.xls" '新檔存檔目錄自行修改
  20. End With
  21.   
  22. End Sub
複製代碼
學海無涯_不恥下問

TOP

melvinhsu1105

帖子
15 
主題
5 
精華
0 
積分
20 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
10 
性別
男 
註冊時間
2011-4-26 
最後登錄
2011-5-13 
7#
發表於 2011-5-11 13:47 | 只看該作者
再補上想完成的範列圖, 再請板主幫忙. 不好意思了.

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2011-5-11 10:18 | 只看該作者
剛利用你回覆的碼套用, 似乎無法執行. 但也沒有程式偵錯的 ...
melvinhsu1105 發表於 2011/5/11 09:57

我也不知道?  沒看到你的檔案  不知你如何套用   [同樣的問題]

PS:   2樓  同樣的問題 ->你沒將你確切想法說詳細 用範例來表達.

TOP

melvinhsu1105

帖子
15 
主題
5 
精華
0 
積分
20 
點名
0  
作業系統
WINDOWS 
軟體版本
XP 
閱讀權限
10 
性別
男 
註冊時間
2011-4-26 
最後登錄
2011-5-13 
5#
發表於 2011-5-11 09:57 | 只看該作者
回復 4# GBKEE


板主, 感謝您一直耐心回覆, 而 剛利用你回覆的碼套用, 似乎無法執行. 但也沒有程式偵錯的訊息.

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2011-5-11 08:51 | 只看該作者
回復 3# melvinhsu1105
是這樣媽?
  1. Option Explicit
  2. Sub Ex()
  3.     Dim AR(), C%, i%, ii%
  4.     ReDim AR(0)                                         'ReDim:重新配置動態陣列變數的儲存空間 ->0到0
  5.     With ActiveSheet
  6.         C = .[B1].End(xlToRight).Column                  '取的:B1往右連續資料表頭最後的欄位數
  7.         AR(0) = .Range("B1", .Cells(1, C)).Value         '指定:陣列的元素值
  8.         For i = 2 To .Cells(2, "A").End(xlDown).Row      '迴圈:從A2開始往下直到沒資料的列位
  9.             For ii = 1 To .Cells(i, "A").Value           '迴圈:從1開始到.Cells(i, "A").Value =複製的筆數
  10.                 ReDim Preserve AR(UBound(AR) + 1)        'ReDim:重新配置動態陣列變數的儲存空間->原有維數+1
  11.                 'Preserve:當改變原有陣列最後一維的大小時，仍然保有原來的資料的關鍵字。
  12.                 'UBound:表示指定陣列某維最大可使用的陣列索引
  13.                 AR(UBound(AR)) = .Range(.Cells(i, "B"), .Cells(i, C)).Value '指定:陣列最大的元素值
  14.             Next
  15.         Next
  16.     End With
  17.     With Workbooks.Add.Sheets(1).Range("A1")   'With: 在一個單一物件或一個使用者自訂型態上執行一系列的陳述式。
  18.         For i = 0 To UBound(AR)                '迴圈:從AR的第1個元素(0)到AR的最大元素UBound(AR)
  19.             .Offset(i).Resize(, C - 1) = AR(i) '.Offset(i):在此i表往下的列數
  20.             '.Resize(, C - 1): 擴充的範圍為(1列,C - 1欄)=陣列元素的值
  21.         Next
  22.     End With
  23. End Sub
複製代碼

TOP

        靜思自在 : 每天無所事事，是人生的消費者，積極、有用才是人生的創造者。
12
返回列表 上一主題