骑行通过不同的范围复制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