用新值替换所有工作表中的值

Question

我有大约 40 个电子表格，每个电子表格最多包含 300k 行 x 93 列（目前）。这大约是 11 亿个数据点。我需要检查每个单元格，并确定该单元格是否包含 8 个特殊字符之一，这些字符在导入电子表格时被搞砸了。

这是一项需要每天多次运行的任务，以及许多其他步骤。因此，我正在寻找一种使用 VBA 的方法。我有以下代码：

Sub Hide_All_Sheets()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = False

Dim k As Integer
Dim t As String
Dim x As Integer

k = Sheets.Count
x = 1

    While x <= k
        t = Sheets(x).Name
        If t = "Launch Screen" Or t = "Equiv sheet" Then
            x = x + 1
        ElseIf t = "Summary_1" And Worksheets("Launch Screen").Range("N5") = "1" Then
            Sheets(x).Visible = True
            x = x + 1
        Else

            Cells.Replace What:="ö", Replacement:=Chr(214), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
            Cells.Replace What:="ü", Replacement:=Chr(220), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
            Cells.Replace What:="ä", Replacement:=Chr(220), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
            Cells.Replace What:="ß", Replacement:=Chr(223), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
            Cells.Replace What:="è", Replacement:=Chr(200), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
            Cells.Replace What:="Ü", Replacement:=Chr(223), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False
            Cells.Replace What:="Ä", Replacement:=Chr(223), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
            ReplaceFormat:=False

            Sheets(x).Visible = False
            x = x + 1
        End If

    Wend

End Sub

唯一的问题是它将加载过程从 20 秒变为 900 秒。

我想知道有没有办法更快地做到这一点？特别是如果有一种方法可以运行手动 CTRL-H 进程，并在所有电子表格中替换，但使用 VBA？

Answer 1

11 亿个任务还有很多工作要做。您的代码有条不紊地循环遍历每个工作表广告，替换输入中损坏的七个（不是）特殊字符中的每一个。

以下使用工作簿范围的方法来替换通过工作表集合的循环。这可能有助于保留要处理的信息的“负载”。

Sub Repair_All_Worksheets()
    Dim fr As Long, FandR As Variant, vWSs As Variant

    appTGGL bTGGL:=False

    FandR = Array("ö", Chr(214), "ü", Chr(220), "ä", Chr(220), "ß", Chr(223), _
              "è", Chr(200), "Ü", Chr(223), "Ä", Chr(223))

    With ActiveWorkbook
        ReDim vWSs(1 To .Worksheets.Count)
        For fr = LBound(vWSs) To UBound(vWSs)
            vWSs(fr) = .Worksheets(fr).Name
        Next fr

        With .Worksheets(vWSs)
            .Select
            .Parent.Worksheets(vWSs(1)).Activate
            For fr = LBound(FandR) To UBound(FandR) Step 2
                Cells.Replace What:=FandR(fr), Replacement:=FandR(fr + 1), LookAt:=xlPart
            Next fr
        End With
    End With

    appTGGL

End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    Debug.Print Timer
    With Application
        .ScreenUpdating = bTGGL
        .EnableEvents = bTGGL
        .DisplayAlerts = bTGGL
        .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
    End With
End Sub

Application.EnableEvents property 与其他环境变量一起被禁用。 Application.Calculation 同样被暂时挂起至xlCalculationManual。这对于具有可变函数的工作表尤其重要，而这里似乎不是这种情况。

顺便说一句，在导入数据时，文本导入向导允许您在 File origin: 文本框中的第一页上指定代码页。将此设置为正确的区域代码页（或者可能只是 65001：Unicode (UTF-8)）应该可以修复您的导入。 Workbooks.OpenText method 有类似的选项。

Answer 2

XL 查找和替换对话框允许我们在工作簿中“全部替换”。您需要做的就是手动调用一次对话框，将搜索设置为“工作簿”，然后点击一次查找下一个。

现在您不必遍历每张工作表来查找和替换。

Afaik 这是设置 XlSearchWithin.xlWithinWorkbook 以确定 Find 和 Replace 搜索范围的唯一方法。