Excel VBA只在最後一張工作表

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