Excel VBA新手求助：单元格数字与对应标识乘积求和代码调试

Let's walk through fixing your SumNums function—there are a few key issues in the original code that are preventing it from working correctly, plus some improvements we can make to make it more robust.

What Was Wrong With the Original Code #

• Incorrect Range Handling: You tried to split the Range object directly (Split(pWorkRng, ",")) instead of first grabbing its actual cell value. VBA can't split a Range like that—you need to use pWorkRng.Value.
• Broken Matching Logic: When you split the cell content, each item looks like " 8 cpls" (with leading space and the number included). Your code was trying to match this full string to just the identifier (like "cpls"), which would never work.
• Index Out-of-Bounds Risk: If your cell had an identifier not in your amounts array, the Do Until loop would keep incrementing j past 12, triggering a "Subscript out of range" error.

Corrected Code #

Function SumNums(pWorkRng As Range) As Double
    Dim cellValue As String
    Dim arr As Variant
    Dim xIndex As Long
    Dim j As Long
    Dim currentPart As String
    Dim num As Double
    Dim amounts(1 To 12) As String
    
    ' Map identifiers to their multipliers (1-12)
    amounts(1) = "singles"
    amounts(2) = "cpls"
    amounts(3) = "grp/3"
    amounts(4) = "grp/4"
    amounts(5) = "grp/5"
    amounts(6) = "grp/6"
    amounts(7) = "grp/7"
    amounts(8) = "grp/8"
    amounts(9) = "grp/9"
    amounts(10) = "grp/10"
    amounts(11) = "grp/11"
    amounts(12) = "grp/12"
    
    ' Get and clean the cell's text (handle empty cells)
    cellValue = Trim(pWorkRng.Value)
    If cellValue = "" Then
        SumNums = 0
        Exit Function
    End If
    
    ' Split the cell content by commas
    arr = Split(cellValue, ",")
    
    ' Loop through each split segment
    For xIndex = LBound(arr) To UBound(arr)
        currentPart = Trim(arr(xIndex)) ' Remove leading/trailing spaces from the segment
        num = Val(currentPart) ' Extract the numeric value from the segment
        
        ' Check which identifier matches this segment
        For j = 1 To 12
            ' Look for the identifier in the segment (case-insensitive)
            If InStr(1, currentPart, amounts(j), vbTextCompare) > 0 Then
                SumNums = SumNums + num * j
                Exit For ' Stop checking once we find the match
            End If
        Next j
    Next xIndex
End Function

Key Improvements & Fixes #

1. Proper Range Value Extraction: We first get the cell's text with Trim(pWorkRng.Value) to remove extra spaces, and handle empty cells by returning 0 immediately.
2. Functional Matching: Instead of trying to match the full segment to the identifier, we use InStr to check if the identifier exists within the segment. This works even with leading spaces and the number included. We also use vbTextCompare to ignore case (so "Singles" or "CPLS" would still work).
3. Safe Loop Structure: The inner loop runs from 1 to 12 (the bounds of your amounts array), so we never run into an out-of-bounds error if an identifier isn't found (it just skips that segment instead).
4. Clearer Variable Names: Renamed variables for readability, making it easier to follow what each part does.

Testing It Out #

For your example cell content: 7 singles, 8 cpls, 4 grp/3, 2 grp/5, 1 grp/8
The function calculates:
(7*1) + (8*2) + (4*3) + (2*5) + (1*8) = 7 + 16 + 12 + 10 + 8 = 53
You'll get the correct result of 53 when you use =SumNums(A1) (assuming your content is in cell A1).

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