Question

我有一个宏我正在尝试在同一个文件夹中的多个工作簿上运行。我目前有以下内容，但是当我运行它时（在VBA中使用F5 for excel），没有任何反应。 excel VBA窗口只是闪烁，但是没有一个工作簿，即使是第一个，也受宏的影响。如果它有帮助，有时F5会要求我确认我正在运行“Sheet1.DoAllFiles”。我是初学者，所以我确信这很简单，我很遗憾 - 但是让这个程序循环的任何帮助都会受到赞赏。谢谢！

我发现的循环代码：

Sub DoAllFiles()
Dim Filename, Pathname As String
Dim WB As Workbook

'Pathname = "G:\Google Drive\2013-2014\Testingbeforedeployment"
'One pathname is coded out depending on what computer I'm running it from
Pathname = "C:\Users\Maptop\Google Drive\2013-2014\Testingbeforedeployment"
Filename = Dir(Pathname & "\*.xls*")
Do While Filename <> ""

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do While Filename <> ""
    Set WB = Workbooks.Open(Pathname & "\" & Filename)  'open all files
    Call Simplify(WB)
    WB.Close SaveChanges:=True
    Set WB = Nothing
    Filename = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Loop
End Sub

我的循环应该调用的宏：

Private Sub Simplify(WB As Workbook)
Sheets.Add After:=Sheets(Sheets.Count)
Const tlh As String = "Credited"
    With Sheets("Inventory") 'Change to suit
        Dim tl As Range, bl As Range
        Dim first_add As String, tbl_loc As Variant
        Set tl = .Cells.Find(tlh)
        If Not tl Is Nothing Then
            first_add = tl.Address
        Else
            MsgBox "Table does not exist.": Exit Sub
        End If
        Do
            If Not IsArray(tbl_loc) Then
                tbl_loc = Array(tl.Address)
            Else
                ReDim Preserve tbl_loc(UBound(tbl_loc) + 1)
                tbl_loc(UBound(tbl_loc)) = tl.Address
            End If
            Set tl = .Cells.FindNext(tl)
        Loop While tl.Address <> first_add
        Dim i As Long, lrow As Long, tb_cnt As Long: tb_cnt = 0
        For i = LBound(tbl_loc) To UBound(tbl_loc)
            Set bl = .Cells.Find(vbNullString, .Range(tbl_loc(i)) _
                , , , xlByColumns, xlNext)
            lrow = Sheets("Sheet1").Range("A" & _
                   Sheets("Sheet1").Rows.Count).End(xlUp).Row
            .Range(.Range(tbl_loc(i)).Offset(0, 3)(IIf(tb_cnt <> 0, 1, 0),     0), _
                bl.Offset(-1, 0)).Resize(, 9).Copy _
                Sheets("Sheet1").Range("A" & lrow).Offset(IIf(lrow = 1, 0,     1), 0)
            tb_cnt = tb_cnt + 1
            Set bl = Nothing
        Next
    End With
End Sub

Answer 1

你还有一个额外的Do While...Loop ......

Sub DoAllFiles()

    Dim Filename, Pathname As String
    Dim WB As Workbook

    'Pathname = "G:\Google Drive\2013-2014\Testingbeforedeployment"
    Pathname = "C:\Users\Maptop\Google Drive\2013-2014\Testingbeforedeployment"

    Filename = Dir(Pathname & "\*.xls*")
    Do While Filename <> ""

        Application.DisplayAlerts = False
        Application.ScreenUpdating = False

        Set WB = Workbooks.Open(Pathname & "\" & Filename)  'open all files
        Simplify WB '<<<EDIT
        WB.Close SaveChanges:=True

        Application.DisplayAlerts = True
        Application.ScreenUpdating = True

        Filename = Dir()

    Loop

End Sub

在您的Simplify() Sub中，您似乎无法引用WB，并且您的所有Sheets引用都没有工作簿限定符：默认情况下，它们将引用ActiveWorkbook，但是你不应该依赖它。从您的代码中，您不清楚是否打算在WB或包含代码的工作簿中引用工作表。

VBA Excel循环文件夹

1 个答案: