騎行通過不同的範圍複製while循環

Question

這是我目前的代碼。

Sub Loops() 

    Dim MyPath As String 
    Dim MyFileName As String 
    Dim output As Variant 
    Dim outputRange(1 To 3) As Range 

    Set outputRange(1) = Worksheets("vbaTest").Range("output1", Worksheets("vbaTest").Range("output1").End(xlDown)) 
    Set outputRange(2) = Worksheets("vbaTest").Range("output2", Worksheets("vbaTest").Range("output2").End(xlDown)) 
    Set outputRange(3) = Worksheets("vbaTest").Range("output3", Worksheets("vbaTest").Range("output3").End(xlDown)) 

For Each output In outputRange 

    'The path and file names: 
    MyPath = "C:\Users\x\Custom Office Templates" 
    MyFileName = "Test" 
    'Makes sure the path name ends with "\": 
    If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\" 
    'Makes sure the filename ends with ".csv" 
    If Not Right(MyFileName, 4) = ".txt" Then MyFileName = MyFileName & ".txt" 
    'Copies the sheet to a new workbook: 
    Sheets("vbaTest").Range("**output1**").Copy 
    'The new workbook becomes Activeworkbook: 
    Workbooks.Add 
    ActiveSheet.Columns("A").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    With ActiveWorkbook 
     Application.DisplayAlerts = False 

End With 

'Brings back original sheet 
Workbooks("vbaTest.csv").Activate 
'Starts at the top of code 
Next output 

End Sub 

我無法循環顯示output1中設置的不同範圍。 「表格（」vbaTest「）。範圍（」output1「）。複製」

我試圖讓vba循環通過我設置的三個其他輸出。有什麼建議麼？

Answer 1

你可以縮短到：

Option Explicit 

Sub Loops() 
    Dim MyPath As String 
    Dim MyFileName As String 
    Dim output As Variant 
    Dim outputRange(1 To 3) As Range 


    With Worksheets("vbaTest") '<--| reference your worksheet once and for all! 
     Set outputRange(1) = .Range("output1", .Range("output1").End(xlDown)) '<--| all "dotted" reference implicitly assume the object after preceeding 'With' keyword as the parent one 
     Set outputRange(2) = .Range("output2", .Range("output2").End(xlDown)) 
     Set outputRange(3) = .Range("output3", .Range("output3").End(xlDown)) 
    End With 

    For Each output In outputRange 
     Workbooks.Add.Worksheets(1).Range("A1").Resize(output.Rows.Count).Value = output.Value 
    Next output 

' the following code doesn't currently depend on looping variable 
' so I put it outside the loop-> I guess you're setting the new workbooks names 

    'The path and file names: 
    MyPath = "C:\Users\x\Custom Office Templates" 
    MyFileName = "Test" 
    'Makes sure the path name ends with "\": 
    If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\" 
    'Makes sure the filename ends with ".csv" 
    If Not Right(MyFileName, 4) = ".txt" Then MyFileName = MyFileName & ".txt" 


End Sub 

Answer 2

在這個網站上有不少文章與避免Select，如果你只需要值，那麼Copy/Paste也可以避免。可能值得閱讀它們來幫助您提高編程的效率。

就循環而言，使用For i = 1 to n樣式循環迭代數組的索引可能會更容易。這使您可以將對象作爲Range而不是For Each ...樣式循環中所需的Variant來引用。

總之，你的代碼迴路元件可以簡化爲：

'Add these declarations 
Dim wb As Workbook 
Dim i As Long 

For i = LBound(outputs) To UBound(outputs) 
    '... 
    Set wb = Workbooks.Add 
    wb.Worksheets(1).Range("A1") _ 
     .Resize(outputs(i).Rows.Count, outputs(i).Columns.Count) _ 
     .Value = outputs(i).Value2 
Next 

Answer 3

無需任何額外的變化，你應該把上面一行Sheets("vbaTest").Range(output.address).Copy。

但是，請注意您如何使用.Copy，然後粘貼特殊值？相反，我們可以設置兩個範圍相等。此外，你應該使用工作簿/工作表變量，以保持直線。

這裏有一個稍微調整了代碼：

Sub Loops() 

    Dim MyPath As String, MyFileName As String 
    Dim output As Variant 
    Dim outputRange(1 To 3) As Range 
    Dim newWB As Workbook 
    Dim newWS As Worksheet, mainWS As Worksheet 

    Set mainWS = Worksheets("vbaTest") 

    With mainWS 
     Set outputRange(1) = .Range("output1", .Range("output1").End(xlDown)) 
     Set outputRange(2) = .Range("output2", .Range("output2").End(xlDown)) 
     Set outputRange(3) = .Range("output3", .Range("output3").End(xlDown)) 
    End With 

For Each output In outputRange 
    Debug.Print output.Address 
    'The path and file names: 
    MyPath = "C:\Users\x\Custom Office Templates" 
    MyFileName = "Test" 
    'Makes sure the path name ends with "\": 
    If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\" 
    'Makes sure the filename ends with ".csv" 
    If Not Right(MyFileName, 4) = ".txt" Then MyFileName = MyFileName & ".txt" 

    'The new workbook becomes Activeworkbook: 
    Set newWB = Workbooks.Add 
    Set newWS = newWB.ActiveSheet 

    'Instead of .Copy/.PasteSpecial Values (meaning, you just want the text), we can 
    ' skip the clipboard completely and just set the two ranges equal to eachother: 
    ' Range([destination]).Value = Range([copy range]).Value 
    newWS.Columns("A").Value = mainWS.Range(output.Address).Value 
    With newWB 
     Application.DisplayAlerts = False 
    End With 

'Brings back original sheet 
mainWS.Activate 
'Starts at the top of code 
Next output 

End Sub 

Answer 4

我從上面，用戶得到的答案作品的方式我想它低於：

表（ 「vbaTest」）範圍（output.address）.Copy