Option Explicit
'
'diese Arbeitsmappe hat Verweis - Microsoft VbScript Regular Expressions
'
'ist zwar etwas langsamer aber besser als der ganze Schrott bisher
'
Sub addNumbers()
Dim regex As RegExp, oMatches As MatchCollection, oMatch As Match, oSubMatch As Match
Dim LastRow As Long, x As Long
Set regex = CreateObject("VBScript.RegExp")
With regex
.Pattern = "[0-9]+"
.Global = True
End With
With Worksheets(1) 'Arbeitsblatt festlegen
LastRow = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
For x = 1 To LastRow
If InStr(.Cells(x, 1).Value, Chr(34)) Then
.Cells(x, 2).ClearContents
If regex.Test(.Cells(x, 1).Value) Then
Set oMatches = regex.Execute(.Cells(x, 1).Value)
For Each oMatch In oMatches
.Cells(x, 2).Value = .Cells(x, 2).Value + CLng(oMatch.Value)
Next oMatch
End If
End If
Next x
End With
Set regex = Nothing
End Sub
|