Excel VBA提取美元符号后数字至B、C列的问题修正

需求 #

A列有多行文本，每行包含两个紧跟美元符号（$）的数字，数字可能含逗号（,）或点号（.），需将两个数字分别提取至B、C列。

现有代码问题 #

改编的VBA代码存在两个核心错误：

• 数字中的逗号/点号会被当作分隔符，导致数字被拆分到多列；
• 无法正确捕获第二个带$的数字。

错误示例 #

• 输入文本：Autozone Inc : Wells Fargo raises target price to $3,450 from $3,400
  错误输出：B列=3、C列=450、D列=3
• 输入文本：Compass Inc : Oppenheimer raises target price to $9.50 from $8.50
  错误输出：B列=9、C列=50、D列=8
• 输入文本：Docusign Inc : Jefferies raises target price to $95 from $80
  错误输出：仅C列显示$80

原错误代码 #

Sub ExtractNum()
    
    Dim count, count1 As Integer
    Dim holder As String
    Dim sample, smallSample As String
    Dim r As Integer
    Dim c As Integer
    r = 1
    c = 1
    
    
    Do While Sheet1.Cells(r, c) <> ""
        count = 0
        count1 = 1
        sample = Sheet1.Cells(r, c)
        holder = ""
        Do While count <> Len(sample)
            smallSample = Left(sample, 1)
            If smallSample = "0" Or smallSample = "1" Or smallSample = "2" Or smallSample = "3" Or smallSample = "4" Or smallSample = "5" Or smallSample = "6" Or smallSample = "7" Or smallSample = "8" Or smallSample = "9" Then
                holder = holder & smallSample
            Else
                If holder <> "" Then
                    Sheets(1).Cells(r, c + count1).Value = holder
                    count1 = count1 + 1
                End If
                holder = ""
            End If
            sample = Right(sample, Len(sample) - 1)
        Loop
        r = r + 1
    Loop
End Sub

修正方案 #

核心思路 #

1. 定位文本中美元符号$的位置，仅提取$之后的数字内容；
2. 允许数字包含逗号（,）和点号（.），直到遇到非数字格式字符时停止提取；
3. 只提取前两个带$的数字，分别写入B、C列。

修正后代码 #

Sub ExtractDollarNumbers()
    Dim r As Integer
    Dim cellText As String
    Dim dollarPos As Integer
    Dim currentPos As Integer
    Dim numStr As String
    Dim numCount As Integer
    
    r = 1
    ' 遍历A列非空行
    Do While Sheet1.Cells(r, 1).Value <> ""
        cellText = Sheet1.Cells(r, 1).Value
        dollarPos = 1
        numCount = 0
        
        ' 查找并提取前两个带$的数字
        Do While numCount < 2
            ' 找下一个$的位置
            dollarPos = InStr(dollarPos, cellText, "$")
            If dollarPos = 0 Then Exit Do ' 没有更多$就退出
            
            currentPos = dollarPos + 1
            numStr = ""
            
            ' 提取$后面的完整数字（包含,和.）
            Do While currentPos <= Len(cellText)
                Dim char As String
                char = Mid(cellText, currentPos, 1)
                ' 判断是否是数字、逗号或点号
                If char Like "[0-9]" Or char = "," Or char = "." Then
                    numStr = numStr & char
                    currentPos = currentPos + 1
                Else
                    Exit Do
                End If
            Loop
            
            ' 如果提取到有效数字，写入对应列
            If numStr <> "" Then
                numCount = numCount + 1
                ' 可选：去掉逗号转成可计算数值，保留原格式则删除此行，直接赋值numStr
                Sheet1.Cells(r, numCount + 1).Value = Replace(numStr, ",", "")
            End If
            
            dollarPos = currentPos ' 从当前位置继续找下一个$
        Loop
        
        r = r + 1
    Loop
End Sub

代码说明 #

• 用InStr精准定位$的位置，确保只处理美元符号后的目标数字；
• 提取逻辑允许数字包含逗号和点号，避免拆分完整数字；
• 限制仅提取前两个带$的数字，对应写入B、C列；
• 可选通过Replace去掉逗号，将文本转为可计算的数值，若需保留原数字格式，删除该行即可。

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