Microsoft Office Tutorials and References
In Depth Information
Extracting Numbers from a Text String
Set Rng = Application.InputBox( _¶
Prompt:="Select the cells that you want to modify" & vbCrLf & _¶
vbCrLf & _¶
"The macro will put the results one cell to the right.", _¶
Title:="Extract numbers from...", Type:=8)¶
On Error GoTo 0¶
'Did the user cancel?¶
If Rng Is Nothing Then¶
Exit Sub¶
End If¶
'Turn off screen updating¶
Application.ScreenUpdating = False¶
For Each Cll In Rng.Cells¶
'Try first using regular expressions¶
Ans = WithRegExp(Cll.Value)¶
'Did an error occur?¶
If IsError(Ans) Then¶
Ans = WithoutRegExp(Cll.Value)¶
End If¶
'Put it in the cell¶
Cll.Offset(, 1).Value = Ans¶
'Make sure that trailing zeros were not cleared¶
If Cll.Offset(, 1).Text <> CStr(Ans) Then¶
Cll.Offset(, 1).Value = "'" & CStr(Ans)¶
End If¶
Next Cll¶
'Restore screen updating¶
Application.ScreenUpdating = True¶
End Sub¶
' * * * * *¶
Function WithRegExp(ByVal Text As String) As Variant¶
'Variable declaration¶
Dim RegExp As Object¶
Dim Pattern As String¶
'Continue when error occurs¶
On Error Resume Next¶
Set RegExp = CreateObject("vbscript.regexp")¶
If RegExp Is Nothing Then¶
WithRegExp = CVErr(xlErrValue)¶
Exit Function¶
End If¶
Pattern = "[^\d]+"¶
'Set the properties of the Regular Expression¶
RegExp.Global = True¶
RegExp.Pattern = Pattern¶
'Replace the matching characters¶
WithRegExp = RegExp.Replace(Text, "")¶
Set RegExp = Nothing¶
End Function¶
Search JabSto ::

Custom Search