[已解决]求大神优化一下代码

柒分壊

Sub 批量替换()
Dim arr, i&
arr = ActiveSheet.[a1].CurrentRegion
Application.ScreenUpdating = False
Dim wb As Excel.Workbook
f = Dir(ThisWorkbook.Path & "\*.xl*") '生成查找EXCEL的目录,可以适应不同版本
Do While f <> "" '在目录中循环
    If f <> ThisWorkbook.Name Then  '如果不是打开的工作簿
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f)  '依次打开目录工作薄
        Sheets("报告").Select
        ActiveWorkbook.Save
        For i = 2 To UBound(arr)
            Cells.Replace What:=arr(i, 1), Replacement:=arr(i, 2), LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False
        Next i
        wb.Close True
    End If
    f = Dir
Loop
Application.ScreenUpdating = True
End Sub


想让“报告”那个页出现在表格中

最佳答案

月排行榜 / 总排行榜

zjdh

2022-5-7 12:54

Sub 批量替换()
    Dim arr, i&
    On Error Resume Next  ' 出错则执行下一句，可以跳过不存在的工作表
    arr = ActiveSheet.[a1].CurrentRegion
    Application.ScreenUpdating = False
    f = Dir(ThisWorkbook.Path & "\*.xl*")   
    Do While f <> ""  
        If f <> ThisWorkbook.Name Then  '如果不是本工作簿
            Workbooks.Open (ThisWorkbook.Path & "\" & f)  
            For i = 2 To UBound(arr)
                Sheets(arr(i, 3)).Cells.Replace What:=arr(i, 1), Replacement:=arr(i, 2), LookAt:=xlPart
            Next i
            ActiveWorkbook.Close True
        End If
        f = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

zjdh

Sub 批量替换()
    Dim arr, i&
    On Error Resume Next  ' 出错则执行下一句，可以跳过不存在的工作表
    arr = ActiveSheet.[a1].CurrentRegion
    Application.ScreenUpdating = False
    f = Dir(ThisWorkbook.Path & "\*.xl*")   
    Do While f <> ""  
        If f <> ThisWorkbook.Name Then  '如果不是本工作簿
            Workbooks.Open (ThisWorkbook.Path & "\" & f)  
            For i = 2 To UBound(arr)
                Sheets(arr(i, 3)).Cells.Replace What:=arr(i, 1), Replacement:=arr(i, 2), LookAt:=xlPart
            Next i
            ActiveWorkbook.Close True
        End If
        f = Dir
    Loop
    Application.ScreenUpdating = True
End Sub