Question

我想将此代码实现到下面文件夹中的所有excel文件（接近100）存储。

我正在搜索代码，但无法找到合适的代码。任何人都可以帮助我。

路径：“D：\ Files”

Cells.Replace What:=" (Task Complete)", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
ActiveWorkbook.Save
ActiveWindow.Close

第1步：Excel宏打开文件
第2步：运行代码
第3步：关闭Excel
第4步：打开下一张Excel表格。
步骤5：步骤1到3，依此类推，直到最后一个文件。

Answer 1

以下假设包含此代码的工作簿与要更改的工作簿位于同一文件夹中。

Option Explicit

Public Sub TaskCompleteReplace()
Dim lobjThisWorkBook As Workbook
Dim lobjOtherWorkbook As Workbook
Dim lobjWorksheet As Worksheet

Dim lstrFileSpec As String

Set lobjThisWorkBook = ThisWorkbook

lstrFileSpec = Dir(lobjThisWorkBook.Path + "\*.xls")
Do While Len(lstrFileSpec) > 0
    If InStr(lstrFileSpec, lobjThisWorkBook.Name) = 0 Then
        Workbooks.Open lobjThisWorkBook.Path + "\" + lstrFileSpec
        'Active workbook is now lstrFileSpec
        Set lobjOtherWorkbook = ActiveWorkbook
        For Each lobjWorksheet In lobjOtherWorkbook.Sheets
            Cells.Replace What:=" (Task Complete)", Replacement:="Test Replaced", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False
        Next
        Application.DisplayAlerts = False
        Set lobjWorksheet = Nothing
        lobjOtherWorkbook.Close SaveChanges:=True
        Application.DisplayAlerts = True
        lobjThisWorkBook.Activate
        Set lobjOtherWorkbook = Nothing
    End If
    lstrFileSpec = Dir
Loop

Set lobjThisWorkBook = Nothing

End Sub

Excel宏查找替换文件夹中的所有文件

1 个答案: