AW: Zahlen suchen und eine andere Spalte schreiben
30.07.2009 08:24:54
Tino
Hallo,
so habe mal jede Menge Kommentare eingetragen, vielleicht Hilft Dir dies ja.
Option Explicit
'Funktion erwartet einen Wert von Typ Variant und
'gibt als Rückgabe auch einen Varianten (zur Sicherheit) Datentyp.
Function ZahlAusString(varWert As Variant)
Dim objReg
'einfach mal Google suchen nach: Reguläre Ausdrücke / Regular Expressions
Set objReg = CreateObject("VBScript.RegExp")
With objReg
.Pattern = "\D"
.Global = True
ZahlAusString = .Replace(varWert, "")
End With
If IsNumeric(ZahlAusString) Then ZahlAusString = ZahlAusString * 1
Set objReg = Nothing
End Function
Sub Test()
Dim meAr1, meAr2 '2 Array- Variablen Typ Variant
Dim Bereich As Range 'Range Variable
Dim A As Long 'Zähler
Dim Wert 'Variant Variable
With Sheets("Tabelle1") 'Tabellenname anpassen
'Bereich ab A2 bis zur letzten gefüllten in Spalte A festlegen
Set Bereich = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
'diesen Bereich in einem Array speichern
meAr1 = Bereich
'ein zweites Array anlegen, Spalte C bis E
meAr2 = .Range(Bereich.Offset(0, 2), Bereich.Offset(0, 4))
'Bereich auf Spalte C bis E festlegen
Set Bereich = .Range(Bereich.Offset(0, 2), Bereich.Offset(0, 4))
End With
'Schleife 1. Index bis zum letzten Index der Array
For A = 1 To Ubound(meAr1)
'ist Wert eine Zahl und kein Datum und nicht leer
If IsNumeric(meAr1(A, 1)) And Not IsDate(meAr1(A, 1)) And meAr1(A, 1) <> "" Then
Wert = meAr1(A, 1) 'diesen Wert in einer Variablen speichern
ElseIf meAr1(A, 1) <> "" And IsDate(meAr1(A, 1)) Then 'Wert nicht leer und ist ein Datum
meAr2(A, 1) = Wert 'den gespeicherten wert in die Array schreiben
meAr2(A, 3) = ZahlAusString(meAr2(A, 2)) 'die Zahl mit der Funktion oben extrahieren
End If
Next A
Bereich = meAr2 'alle Daten in den Bereich zurückschreiben
End Sub
Gruß Tino