Replace values across ALL worksheets with new value

问题

I have about 40 spreadsheets, each containing up to 300k rows x 93 columns (currently). That is about 1.1 billion data points. I need to check through each cell, and determine if the cell contains one of 8 special characters, that has been messed up on the importation of the spreadsheet.

This is a task that needs to be run multiple times daily, along with a number of other steps. As such, I'm looking for a way to do this using VBA. I have the following code:

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

Only problem is that it turns the load process from being 20 seconds to 900 seconds.

I'm wondering is there a way to do this faster? Especially if there is a way to run the manual CTRL-H process, and replace across all spreadsheets, but using VBA?

回答1:

1.1 billion tasks is still a lot of work to do. Your code is methodical about looping through each worksheet ad replacing each of the seven (not 8) special characters that were corrupted on the input.

The following uses a workbook-wide method to replace the loop through the worksheets collection. This may help by retaining the 'load' of the information to be processed.

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

The Application.EnableEvents property is disabled along with the other environment variables. The Application.Calculation is likewise temprarily suspended to xlCalculationManual. This would be especially important to a worksheet with volatile functions which does not seem to be the case here.

btw, when importing data the Text Import Wizard allows you to specify the codepage on the first page within the File origin: text box. Setting this to the correct regional codepage (or possibly just 65001: Unicode (UTF-8)) should fix your import to start with. The Workbooks.OpenText method has similar options.

回答2:

XL Find and Replace dialog allows us to "replace all" within the workbook. All you need to do is manually call the dialog once, set the search within to "Workbook", and hit Find Next once.

Now you don't have to loop through each sheet to find and replace.

Afaik this is the only wayt to set the XlSearchWithin.xlWithinWorkbook to determine the scope the Find and Replace search.

来源：https://stackoverflow.com/questions/35939045/replace-values-across-all-worksheets-with-new-value

标签

excel

vba

excel-vba