在循环时循环通过不同的范围进行复制

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 时，我无法循环遍历我设置的不同范围。 "Sheets("vbaTest").Range("output1").Copy"

我试图让 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

我从上面的用户那里收到的答案如下：

Sheets("vbaTest").Range(output.address).Copy