1

我是 vba 宏编写的真正初学者,我面临一个问题。我查找了一个循环宏,它循环一个文件夹中的文件并合并一个。问题是某些文件具有函数,因此在某些列中我面临参考问题,因此我需要值而不是函数。我一直在寻找解决方案两天,但没有任何进展。我是一家跨国公司的实习生,这将使我的工作更轻松。这是我的宏:

Sub LoopThroughFolder()

Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range
Set Wb = ThisWorkbook
MyDir = "D:\PersonalData\BodaBali\Desktop\vba loop\"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("IT&SYS")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()
 Loop

Set Wb = ThisWorkbook
MyDir = "D:\PersonalData\BodaBali\Desktop\vba loop\"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("Prof Cons")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()

Loop

Set Wb = ThisWorkbook
MyDir = "D:\PersonalData\BodaBali\Desktop\vba loop\"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("Travel")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()

Loop


Set Wb = ThisWorkbook
MyDir = "D:\PersonalData\BodaBali\Desktop\vba loop\"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("Conference&Entertainment")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet4").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()

Loop

Set Wb = ThisWorkbook
MyDir = "D:\PersonalData\BodaBali\Desktop\vba loop\"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("Staff Rel")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()

Loop

Set Wb = ThisWorkbook
MyDir = "D:\PersonalData\BodaBali\Desktop\vba loop\"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("Other")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet6").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()

 Loop

Set Wb = ThisWorkbook
MyDir = "D:\PersonalData\BodaBali\Desktop\vba loop\"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("Facilities&Real Estate")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet7").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()

Loop
End Sub
4

2 回答 2

0

你需要用两行而不是一行来做你的.Copyand :.Paste

With Worksheets("Travel")
    Rws = .Cells(Rows.Count, "A").End(xlUp).Row
    Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
    Rng.Copy 
    Wb.Worksheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    ActiveWorkbook.Close True
End With

此外,同意每个人的观点,这里最好使用一个循环,处理该循环内的每个工作表。

就像是:

Sub LoopThroughFolder()

Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range
Set Wb = ThisWorkbook
MyDir = "D:\PersonalData\BodaBali\Desktop\vba loop\"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("IT&SYS")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy 
        Wb.Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues        
    End With
    With Worksheets("Prof Cons")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy 
        Wb.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues       
    End With
    With Worksheets("Travel")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues        
    End With
    With Worksheets("Conference&Entertainment")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy 
        Wb.Worksheets("Sheet4").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues        
    End With
    With Worksheets("Staff Rel")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy 
        Wb.Worksheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues        
    End With
    With Worksheets("Other")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy 
        Wb.Worksheets("Sheet6").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues       
    End With
    With Worksheets("Facilities&Real Estate")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy 
        Wb.Worksheets("Sheet7").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)       
    End With
    ActiveWorkbook.Close True
    MyFile = Dir()
 Loop




End Sub

这仍然可以清理,因为这里有很多复制/粘贴代码,但这会更有效率。

于 2018-04-23T13:27:17.547 回答
0

您的重复块可以是一个单独的过程,您可以使用不同的参数调用。
请注意,您会多次循环浏览文件。
根本不使用复制,而是传输范围值。
我会怎么做:

Sub LoopThroughFolder()
    Dim MyFile As String, MyDir As String ',Str As String <- not used
    Dim Wb As Workbook
    MyDir = "D:\PersonalData\BodaBali\Desktop\vba loop\"
    MyFile = Dir(MyDir & "*.xl??")
    ChDir MyDir
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    Do While MyFile <> ""
        Set Wb = Workbooks.Open(MyFile)
        HelpSub Wb.Worksheets("Prof Cons"), ThisWorkbook.Worksheets("Sheet1")
        HelpSub Wb.Worksheets("IT&SYS"), ThisWorkbook.Worksheets("Sheet2")
        HelpSub Wb.Worksheets("Travel"), ThisWorkbook.Worksheets("Sheet3")
        HelpSub Wb.Worksheets("Conference&Entertainment"), ThisWorkbook.Worksheets("Sheet4")
        HelpSub Wb.Worksheets("Staff Rel"), ThisWorkbook.Worksheets("Sheet5")
        HelpSub Wb.Worksheets("Other"), ThisWorkbook.Worksheets("Sheet6")
        Wb.Close False
        MyFile = Dir()
    Loop
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub
Private Sub HelpSub(wsSource As Worksheet, wsDestination As Worksheet)
    Dim Rng As Range, Rws As Long
    With wsSource
        Rws = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set Rng = .Range(.Cells(1, 35), .Cells(Rws, 2))
        wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp). _
            Offset(1, 0).Resize(Rng.Rows.Count, Rng.Columns.Count).Value = Rng.Value
    End With
End Sub
于 2018-04-23T13:42:09.837 回答