AW: Alles sechsstellige Zahlen auflisten
26.08.2009 14:33:53
fcs
Hallo Martin,
das geht nach meiner Einschätzung mit Standardfunktionen nicht mehr. Das erfordert eine benutzerdefinierte Funktion.
Die nachfolgende Prozedur kopierst du im VBA-Editor in ein allgemeines Modul der Datei.
Anschließend kannst du die Funktion wie jede andere in Formeln der Datei benutzen.
Gruß
Franz
Formel-Beispiele:
=fncZiffernPaket(C3;6;",") 'Ziffernblöcke mit Komma als Trennzeichen
=fncZiffernPaket(C3) 'Ziffernblöcke mit Leerzeichen als Trennzeichen
Function fncZiffernPaket(Zelle As Range, _
Optional BlockLaenge As Long = 6, _
Optional strSep As String = " ") As String
'Sucht im Text der Zelle nach Ziffernblöcken der Länge Blocklaenge und fügt die _
Ziffern zu einem Textstring mit Trennzeichen zusammen
Dim lngPos, bolZahl As Boolean, Text As String
Text = Zelle.Text
'Prüfen, ob Text eine Zahl mit BlockLaenge ist
If IsNumeric(Text) And Len(Text) = BlockLaenge Then
fncZiffernPaket = Text
'Prüfen, ob Text eine Zahl mit Länge ungleich BlockLaenge ist
ElseIf IsNumeric(Text) And Len(Text) BlockLaenge Then
fncZiffernPaket = ""
Else
'Prüfen, ob im Text eine(mehrere) Zahl(en) mit Länge ungleich BlockLaenge ist(sind)
For lngPos = 1 To Len(Text) - BlockLaenge - 1
bolZahl = False
'Prüfen, ob BlockLaenge Zeichen langer Abschnitt im Text eine Zahl ist
If IsNumeric(Mid(Text, lngPos, BlockLaenge)) Then
'Prüfen 7. Zeichen keine Zahl ist, wenn BlockLaenge Ziffern am Anfang
If lngPos = 1 And Not IsNumeric(Mid(Text, lngPos + BlockLaenge, 1)) Then
bolZahl = True
'Prüfen ob 7.-letztes Zeichen keine Zahl wenn BlockLaenge Ziffern am Ende
ElseIf Not IsNumeric(Mid(Text, lngPos - 1, 1)) _
And lngPos = Len(Text) - BlockLaenge - 1 Then
bolZahl = True
'Prüfen, ob Zeichen links und rechts des Blocks keine Ziffer
ElseIf Not IsNumeric(Mid(Text, lngPos - 1, 1)) _
And Not IsNumeric(Mid(Text, lngPos + BlockLaenge, 1)) Then
bolZahl = True
End If
'Wenn 6er-Ziffern-Block, dann zum Ergebnis hinzufügen
If bolZahl = True Then
If fncZiffernPaket = "" Then
fncZiffernPaket = Mid(Text, lngPos, BlockLaenge)
Else
fncZiffernPaket = fncZiffernPaket & strSep & Mid(Text, lngPos, BlockLaenge)
End If
lngPos = lngPos + BlockLaenge
End If
End If
Next
End If
End Function