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

我遇到输出1时设置的不同范围的问题。＆＃34;表（＆＃34; vbaTest＆＃34）范围内。（＆＃34;的 OUTPUT1 ＆＃34）。复制＆＃34;

我试图让vba循环浏览我设置的其他三个输出。有什么建议吗？

Answer 1

此网站上有相当多的帖子与避免Select相关，如果您只需要这些值，那么Copy/Paste也可以避免。可能值得阅读它们以帮助提高编程效率。

就循环而言，使用For i = 1 to n样式循环迭代数组的索引可能更容易。这使您可以将对象引用为Range，而不是Variant样式循环中所需的For Each ...。

总之，代码的循环元素可以简化为：

'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 2

如果没有任何其他更改，您只需将该行更改为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 3

你可以缩短为：

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 4

我从上面的用户那里得到的答案就像我想要的那样：

表（ “vbaTest”）。范围（output.address）.Copy

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

4 个答案: