如何使用循環

Question

我有很長的Excel VBA代碼下面，我只是想知道如何使用循環或任何東西，使代碼更短，更好。我正在嘗試做的是複製工作簿的每一列，並將它們粘貼到新工作簿的每個不同工作表中。例如，列A到Sheet1，列B到Sheet2等等。謝謝。

Sub S05_0ab_03() 

    Dim wb As Workbook, wbTemp As Workbook 
    Dim ws As Worksheet, wsTemp As Worksheet 

    Set wb = ThisWorkbook 
    Set ws = wb.Sheets("Sheet1") 
    Set ws2 = wb.Sheets("Sheet2") 
    Set ws3 = wb.Sheets("Sheet3") 
    Set ws4 = wb.Sheets("Sheet4") 
    Set ws5 = wb.Sheets("Sheet5") 
    Set ws6 = wb.Sheets("Sheet6") 
    Set ws7 = wb.Sheets("Sheet7") 
    Set ws8 = wb.Sheets("Sheet8") 
    Set ws9 = wb.Sheets("Sheet9") 
    Set ws10 = wb.Sheets("Sheet10") 
    Set ws11 = wb.Sheets("Sheet11") 
    Set ws12 = wb.Sheets("Sheet12") 
    Set ws13 = wb.Sheets("Sheet13") 
    Set ws14 = wb.Sheets("Sheet14") 
    Set ws15 = wb.Sheets("Sheet15") 
    Set ws16 = wb.Sheets("Sheet16") 
    Set ws17 = wb.Sheets("Sheet17") 
    Set ws18 = wb.Sheets("Sheet18") 
    Set ws19 = wb.Sheets("Sheet19") 
    Set ws20 = wb.Sheets("Sheet20") 
    Set ws21 = wb.Sheets("Sheet21") 
    Set ws22 = wb.Sheets("Sheet22") 
    Set ws23 = wb.Sheets("Sheet23") 
    Set ws24 = wb.Sheets("Sheet24") 
    Set ws25 = wb.Sheets("Sheet25") 
    Set ws26 = wb.Sheets("Sheet26") 
    Set ws27 = wb.Sheets("Sheet27") 
    Set ws28 = wb.Sheets("Sheet28") 
    Set ws29 = wb.Sheets("Sheet29") 
    Set ws30 = wb.Sheets("Sheet30") 
    Set ws31 = wb.Sheets("Sheet31") 
    Set ws32 = wb.Sheets("Sheet32") 
    Set ws33 = wb.Sheets("Sheet33") 
    Set ws34 = wb.Sheets("Sheet34") 

    '~~> Change path as applicable 
    Set wbTemp = Workbooks.Open("C:\Users\cl0106.UNT\Documents\Jill\0ab\S05_0ab_03.xlsx") 
    Set wsTemp = wbTemp.Sheets("Sheet1") 

    'copy file 
    wsTemp.Range("A3:A102").copy ws.Range("I3:I102") 
    wsTemp.Range("B3:B102").copy ws2.Range("I3:I102") 
    wsTemp.Range("C3:C102").copy ws3.Range("I3:I102") 
    wsTemp.Range("D3:D102").copy ws4.Range("I3:I102") 
    wsTemp.Range("E3:E102").copy ws5.Range("I3:I102") 
    wsTemp.Range("F3:F102").copy ws6.Range("I3:I102") 
    wsTemp.Range("G3:G102").copy ws7.Range("I3:I102") 
    wsTemp.Range("H3:H102").copy ws8.Range("I3:I102") 
    wsTemp.Range("I3:I102").copy ws9.Range("I3:I102") 
    wsTemp.Range("J3:J102").copy ws10.Range("I3:I102") 
    wsTemp.Range("K3:K102").copy ws11.Range("I3:I102") 
    wsTemp.Range("L3:L102").copy ws12.Range("I3:I102") 
    wsTemp.Range("M3:M102").copy ws13.Range("I3:I102") 
    wsTemp.Range("N3:N102").copy ws14.Range("I3:I102") 
    wsTemp.Range("O3:O102").copy ws15.Range("I3:I102") 
    wsTemp.Range("P3:P102").copy ws16.Range("I3:I102") 
    wsTemp.Range("Q3:Q102").copy ws17.Range("I3:I102") 
    wsTemp.Range("R3:R102").copy ws18.Range("I3:I102") 
    wsTemp.Range("S3:S102").copy ws19.Range("I3:I102") 
    wsTemp.Range("T3:T102").copy ws20.Range("I3:I102") 
    wsTemp.Range("U3:U102").copy ws21.Range("I3:I102") 
    wsTemp.Range("V3:V102").copy ws22.Range("I3:I102") 
    wsTemp.Range("W3:W102").copy ws23.Range("I3:I102") 
    wsTemp.Range("X3:X102").copy ws24.Range("I3:I102") 
    wsTemp.Range("Y3:Y102").copy ws25.Range("I3:I102") 
    wsTemp.Range("Z3:Z102").copy ws26.Range("I3:I102") 
    wsTemp.Range("AA3:AA102").copy ws27.Range("I3:I102") 
    wsTemp.Range("AB3:AB102").copy ws28.Range("I3:I102") 
    wsTemp.Range("AC3:AC102").copy ws29.Range("I3:I102") 
    wsTemp.Range("AD3:AD102").copy ws30.Range("I3:I102") 
    wsTemp.Range("AE3:AE102").copy ws31.Range("I3:I102") 
    wsTemp.Range("AF3:AF102").copy ws32.Range("I3:I102") 
    wsTemp.Range("AG3:AG102").copy ws33.Range("I3:I102") 
    wsTemp.Range("AH3:AH102").copy ws34.Range("I3:I102") 


    Application.CutCopyMode = False 

    '~~> Cleanup 
    wbTemp.Close savechanges:=True 
    Set wb = Nothing: Set wbTemp = Nothing 
    Set ws = Nothing: Set ws2 = Nothing: Set wsTemp = Nothing 

下面是我的代碼修改。

Sub Move() 


    Dim wb As Workbook, wbTemp As Workbook 
    Dim wsTemp As Worksheet 
    Dim i As Long, colName As String 
    Dim n As Long, colName2 As String 


    Set wb = ThisWorkbook 

    '~~> Change path as applicable 

    For n = 1 To 4 

     Set wbTemp = Workbooks.Open("C:\Users\cl0106.UNT\Documents\Jill\0ab\" & n & ".xlsx") 
     Set wsTemp = wbTemp.Sheets("Sheet1") 
     colName2 = Split(Cells(, n).Address, "$")(1) 

    For i = 1 To 34 
     colName = Split(Cells(, i).Address, "$")(1) 
     wb.Sheets("Sheet" & i).Range(colName2 & "3" & ":" & colName2 & "102").Value = wsTemp.Range(colName & "3" & ":" & colName & "102").Value 

    Next 
    Next 

    Application.CutCopyMode = False 

    '~~> Cleanup 
    wbTemp.Close savechanges:=False 

    Set wb = Nothing: Set wbTemp = Nothing 
    Set wsTemp = Nothing 


End Sub 

Answer 1

這篇文章覆蓋了幾乎來自閱讀教程邏輯。這是當你有經驗的時候。大多數網站都可以解釋For Loops的工作方式，但要在不同的場景中完全應用它，您必須親自學習。這篇文章將帶您瞭解如何使用該邏輯來最終縮短您的代碼...

For Loops在存在某種趨勢時非常有用。話雖如此，對於像任何其他循環一樣的循環，當你想重複執行某些操作時也可以使用。

如果你看看你的數據，那麼你會看到一個趨勢。例如

工作表Sheet1，Sheet2中...... Sheet34

OR

A3：A102，B3：B102 ... AH3：AH102

現在什麼共同點做上面的東西份額？

工作表名稱從1開始到34結束。同樣在A3:A102, B3:B102... AH3:AH102中，列名從A到AH，只是列1到列34.現在我們如何從Excel的列號中獲取列名。您可以使用這一個班輪從列號中獲取列名稱。

Split(Cells(, num).Address, "$")(1)

哪裏num是列數，以便

Split(Cells(, 1).Address, "$")(1) is Col A 
Split(Cells(, 2).Address, "$")(1) is Col B 
' 
' 
' 
Split(Cells(, 34).Address, "$")(1) is Col AH 

另一部分是你的複製範圍是行方面不變。它始終從第3行到第102行。

同樣，您的目標範圍在字段或行以及列中都是不變的。這使得工作更容易。

現在讓我們嘗試並納入，在for循環...

Sub S05_0ab_03() 
    Dim wb As Workbook, wbTemp As Workbook 
    Dim wsTemp As Worksheet 
    Dim i As Long, colName As String 

    Set wb = ThisWorkbook 

    '~~> Change path as applicable 
    Set wbTemp = Workbooks.Open("C:\Users\cl0106.UNT\Documents\Jill\0ab\S05_0ab_03.xlsx") 
    Set wsTemp = wbTemp.Sheets("Sheet1") 

    For i = 1 To 34 
     colName = Split(Cells(, i).Address, "$")(1) 
     wsTemp.Range(colName & "3" & ":" & colName & "102").Copy _ 
     wb.Sheets("Sheet" & i).Range("I3:I102") 
    Next 

    Application.CutCopyMode = False 

    '~~> Cleanup 
    wbTemp.Close savechanges:=False 

    Set wb = Nothing: Set wbTemp = Nothing 
    Set wsTemp = Nothing 
End Sub