我发现这是一个很好的问题,所以在答案中投入了一些精力。我认为这会做你想要的!它甚至可以使用小数和千位分隔符。
我承认该NumericalValue
函数也可以以不同的方式创建(找到第一个和最后一个数字并获取mid
字符串的那部分。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim rngTarget As Range
Dim varValue As Variant
Set rngTarget = Range("a1:a100")
If Not Intersect(Target, rngTarget) Is Nothing Then
For Each rng In rngTarget
'only check cells that contain an H and a P
If InStr(1, rng, "H") > 0 And InStr(1, rng, "P") > 0 Then
'find the numerical value if any (Empty if not found)
varValue = NumericalValue(rng.Value2)
If Not IsEmpty(varValue) Then
MsgBox "hurray the value of cell " & rng.AddressLocal & " is " & varValue
End If
End If
Next
End If
End Sub
'return the first numerical value found in the cell
Private Function NumericalValue(ByVal strValue As String) As Variant
Dim intChar As Integer
Dim booNumberFound As Boolean
Dim intDecimal As Integer
booNumberFound = False
NumericalValue = Val(strValue)
For intChar = 1 To Len(strValue) Step 1
'if a number found then grow the total numerical value with it
If IsNumeric(Mid(strValue, intChar, 1)) Then
NumericalValue = NumericalValue * IIf(intDecimal = 0, 10, 1) + _
Val(Mid(strValue, intChar, 1)) * 10 ^ -intDecimal
If intDecimal > 0 Then
intDecimal = intDecimal + 1
End If
booNumberFound = True
'if the decimal separator is found then set the decimal switch
ElseIf intDecimal = 0 And booNumberFound = True And Mid(strValue, intChar, 1) = Application.DecimalSeparator Then
intDecimal = 1
'skip the thousand separator to find more numbers
ElseIf booNumberFound = True And Mid(strValue, intChar, 1) = Application.ThousandsSeparator Then
ElseIf booNumberFound = True Then
Exit For
End If
Next intChar
End Function