Excel VBA替换非英文字符：现有代码运行缓慢求优化

Got it, let's fix that slow-running VBA code you're dealing with. The core issue with your current approach is that you're looping through every single cell individually and calling Substitute dozens of times per cell—this is super inefficient because interacting with the Excel worksheet one cell at a time is one of the slowest operations in VBA.

Here's a drastically optimized version that handles all the work in memory (way faster!) and cuts down on unnecessary worksheet interactions, plus it adds standard performance tweaks for VBA:

Sub OptimizedReplaceCharacters()
    Dim ws As Worksheet
    Dim dataArr As Variant
    Dim i As Long, j As Long
    Dim charMap As Object
    Dim cellValue As String
    
    ' Disable Excel's background features to speed up execution
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Set ws = ActiveSheet
    ' Load the entire target range into a memory array (massively faster than cell-by-cell access)
    dataArr = ws.Range("A1:H10000").Value
    
    ' Create a dictionary to map special characters to their English equivalents
    Set charMap = CreateObject("Scripting.Dictionary")
    With charMap
        .Add "Á", "A"
        .Add "Å", "A"
        .Add "á", "a"
        .Add "å", "a"
        .Add "ð", "D"
        .Add "Ð", "D"
        .Add "É", "E"
        .Add "é", "e"
        .Add "í", "i"
        .Add "Í", "I"
        .Add "Ó", "O"
        .Add "ó", "o"
        .Add "ú", "u"
        .Add "Ý", "Y"
        .Add "ý", "y"
        .Add "Þ", "Th"
        .Add "þ", "th"
        .Add "Æ", "AE"
        .Add "æ", "ae"
        .Add "Ø", "O"
        .Add "ø", "o"
        .Add "Ö", "O"
        .Add "Ä", "A"
        .Add "ä", "a"
        .Add "Ü", "U"
        .Add "À", "A"
        .Add "à", "a"
        .Add "È", "E"
        .Add "è", "e"
        .Add "Ì", "I"
        .Add "ì", "i"
        .Add "Ò", "O"
        .Add "ò", "o"
        .Add "Ù", "U"
        .Add "ù", "u"
        .Add "ç", "c"
        .Add "Ç", "C"
        .Add "Â", "A"
        .Add "â", "a"
        .Add "Ê", "E"
        .Add "ê", "e"
        .Add "Î", "I"
        .Add "î", "i"
        .Add "Ô", "O"
        .Add "ô", "o"
        .Add "Û", "U"
        .Add "û", "u"
        .Add "Ñ", "N"
        .Add "ñ", "n"
        .Add "Õ", "O"
        .Add "õ", "o"
        .Add "Ã", "A"
        .Add "ã", "a"
        .Add "Ë", "E"
        .Add "ë", "e"
        .Add "Ï", "I"
        .Add "ï", "i"
    End With
    
    ' Loop through the array to replace characters (all in memory!)
    For i = LBound(dataArr, 1) To UBound(dataArr, 1)
        For j = LBound(dataArr, 2) To UBound(dataArr, 2)
            If VarType(dataArr(i, j)) = vbString Then
                cellValue = dataArr(i, j)
                ' Replace each special character using the dictionary
                For Each key In charMap.Keys
                    cellValue = Replace(cellValue, key, charMap(key))
                Next key
                dataArr(i, j) = cellValue
            End If
        Next j
    Next i
    
    ' Write the modified array back to the worksheet in one single operation
    ws.Range("A1:H10000").Value = dataArr
    
    ' Re-enable Excel's features
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
    MsgBox "Character replacement done!", vbInformation
End Sub

Key Speed Improvements: #

• Memory Array Processing: We load the entire range into a VBA array first. All edits happen in memory, which is orders of magnitude faster than touching individual worksheet cells.
• Dictionary Mapping: Using a Scripting.Dictionary keeps the replacement logic clean and avoids repeated calls to Substitute.
• Performance Tweaks: Disabling screen updates, events, and automatic calculation cuts out Excel's background overhead while the macro runs.
• Single Write Operation: We only push the modified data back to the worksheet once, instead of updating each cell one by one.

Bonus Tips for Your Full Workflow: #

For your other tasks (adjusting column order, deleting duplicates, splitting into 100-row sheets), stick to batch processing to keep things fast:

• Delete Duplicates: Use ws.Range("A1:H" & lastRow).RemoveDuplicates instead of looping to check rows manually.
• Split into 100-Row Sheets: Calculate how many sheets you need, then copy ranges in batches (e.g., ws.Range("A1:H100").Copy to a new sheet) instead of row-by-row.
• Adjust Column Order: Move entire columns at once (e.g., ws.Columns("C").Cut then ws.Columns("A").Insert) instead of cell-by-cell.

内容的提问来源于stack exchange，提问作者banner001