Question

我在下面有一个宏，它在工作簿中运行所有工作表，并运行特定目录中的所有文件。但遗憾的是，它仅适用于每个工作簿中的最后一个工作表。它适用于每张纸。有人可以更正我的代码吗？

Sub LoopThroughFiles()
    Application.ScreenUpdating = False
    FolderName = "C:\Users\Karolek\Desktop\E\3\"
    If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
    Fname = Dir(FolderName & "*.xls")

    'loop through the files
    Do While Len(Fname)

        With Workbooks.Open(FolderName & Fname)

           ' here comes the code for the operations on every file the code finds

           Call LoopThroughSheets

        End With

        ' go to the next file in the folder
        Fname = Dir

    Loop

End Sub

Sub LoopThroughSheets()

    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets

    Call naprawa

    Next ws
    ActiveWorkbook.Close savechanges:=True
End Sub



Sub naprawa()

    Dim fndList As Variant
    Dim rplcList As Variant
    Dim x As Long

    fndList = Array("Louver-", "Lvrs ", "gauge ", "Galvanized ", "Pieces")
    rplcList = Array("Lvr-", "Louvers ", "ga ", "Glvnzd ", "Pcs")
    For x = LBound(fndList) To UBound(fndList)
    Range("C:C,D:D").Select
    Selection.Replace What:=fndList(x), Replacement:=rplcList(x), LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Next x

End Sub

Answer 1

为什么这需要在三个独立的潜艇中？这可以在一个子目录中完成：

Sub LoopThroughFiles()

    Dim ws As Worksheet
    Dim lCalc As XlCalculation
    Dim sFldrPath As String
    Dim sFileName As String
    Dim aFindList() As String
    Dim aRplcList() As String
    Dim i As Long

    sFldrPath = "C:\Test\"
    If Right(sFldrPath, 1) <> Application.PathSeparator Then sFldrPath = sFldrPath & Application.PathSeparator
    sFileName = Dir(sFldrPath & "*.xls*")

    aFindList = Split("Louver-,Lvrs ,gauge ,Galvanized ,Pieces", ",")
    aRplcList = Split("Lvr-,Louvers ,ga ,Glvnzd ,Pcs", ",")

    With Application
        lCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    On Error GoTo CleanExit

    'loop through the files
    Do While Len(sFileName) > 0
        With Workbooks.Open(sFldrPath & sFileName)
            For Each ws In .Sheets
                For i = LBound(aFindList) To UBound(aFindList)
                    ws.Range("C:D").Replace aFindList(i), aRplcList(i), xlPart
                Next i
            Next ws
            .Close True
        End With

        ' go to the next file in the folder
        sFileName = Dir
    Loop

CleanExit:
    With Application
        .Calculation = lCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

Excel VBA仅适用于最后一个工作表

1 个答案: