如何让VBA代码识别TOTAL/TOTAAL后接数字的单元格并排除其他情况？

Let's fix those two frustrating issues in your code:

• Stopping false matches like "SUBTOTAL"
• Ensuring we only flag cells where "TOTAL" or "TOTAAL" are followed by any length of numbers (with optional space in between)

The core problem with your original code was that simple substring searches don't account for word boundaries or required trailing numbers. We'll use regular expressions to create a precise match pattern instead. Here's the revised code:

Sub CopyValues()
    Dim totRegex As Object
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim NoRows As Long
    Dim DestNoRows As Long
    Dim I As Long
    Dim rngCells As Range
    Dim cellValue As String
    
    ' Initialize regex object and define our match pattern
    Set totRegex = CreateObject("VBScript.RegExp")
    ' Pattern breakdown:
    ' \b = word boundary (blocks matches inside longer words like SUBTOTAL)
    ' (TOTAAL|TOTAL) = match either exact term
    ' \s? = optional single space between the term and numbers
    ' \d+ = one or more digits (any length, ensures numbers follow the term)
    totRegex.Pattern = "\b(TOTAAL|TOTAL)\s?\d+"
    totRegex.IgnoreCase = False ' Switch to True if you want case-insensitive matches
    
    Set wsSource = Worksheets("Input")
    Set wsDest = Worksheets("Output")
    
    ' Get last row dynamically (works for all Excel versions)
    NoRows = wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row
    DestNoRows = 2
    
    For I = 1 To NoRows
        Set rngCells = wsSource.Range("A" & I)
        cellValue = Trim(rngCells.Value) ' Clean up extra leading/trailing spaces
        
        ' Check if the cell value matches our regex rules
        If totRegex.Test(cellValue) Then
            rngCells.Copy wsDest.Range("B" & DestNoRows)
            DestNoRows = DestNoRows + 1
        End If
    Next I
    
    ' Clean up objects to free memory
    Set totRegex = Nothing
    Set wsSource = Nothing
    Set wsDest = Nothing
End Sub

Key Improvements Explained: #

• Regex-based matching: The pattern \b(TOTAAL|TOTAL)\s?\d+ eliminates both original issues:
  • \b ensures we only match "TOTAL" or "TOTAAL" as standalone terms (so "SUBTOTAL" gets ignored)
  • \d+ requires at least one digit after the term (plain "TOTAL" without numbers won't trigger a copy)
  • \s? flexibly handles both spaced ("TOTAL 123") and unspaced ("TOTAAL456") formats
• Dynamic row count: Replaced the hardcoded 65536 with wsSource.Rows.Count to support modern Excel versions with more rows
• Memory cleanup: Explicitly set objects to Nothing to avoid lingering memory usage

Optional Tweaks: #

• For case-insensitive matching (e.g., "total 789" should also qualify), change totRegex.IgnoreCase = False to True
• If you need to match cells where the entire content is only "TOTAL/TOTAAL + numbers" (not just containing it), update the pattern to ^\b(TOTAAL|TOTAL)\b\s?\d+$ (the ^ and $ anchor the match to the start/end of the cell value)

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