Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1360to1364
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro für Trennung Str., Hnr und Zusatz

Makro für Trennung Str., Hnr und Zusatz
26.05.2014 12:53:28
onkelbobby

Hi,
In Spalte C einer Tabelle steht eine Adresse in der Form "An der Mauer 11 A".
Ich hätte jetzt gerne eine Sortierung zunächst nach Straße, dann nach Hausnr., dann nach Zusatz.
Also so:
An der Mauer 9
An der Mauer 11 A
An der Mauer 11 B
An der Mauer 25
usw.
Das wird wohl nur funktionieren, wenn in Hilfsspalten Hausnr. und Zusatz von der Straße getrennt werden. Ich habe dazu auch schon ein Makro gefunden, das mir Straße in eine Spalte, sowie Hnr. + Zusatz in eine andere Spalte schreibt. Seltsamerweise werden jedoch bei einigen Hnr. Zusätzen mit "A" die Daten wie eine Uhrzeit angezeigt, also "11:00 AM" statt 11 A. Keine Ahnung warum das so ist.
Wie kriege ich die Sortierung (am besten per Makro) hin?
Danke!

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro für Trennung Str., Hnr und Zusatz
26.05.2014 13:15:40
Daniel
Hi
das Problem ist, dass du für eine Sortierung vor den einstelligen Hausnummern führende Nullen brauchst, damit die Text-Sortierung gewünscht sortiert.
die folgende Funktion fügt dir bei der Hausnummer die führenden Nullen ein, so dass du den gesamttext dann sortieren kannt.
Auch der Fall wenn der Zusatz direkt dan der Nummer steht (80A) wird erkannt dun korrigiert.
Function HausNrMitNull(StrasseUndHausNR As String, Optional Stellen As Long = 2) As String
Dim txt() As String
Dim i As Long
Dim Hnr As Long
txt = Split(StrasseUndHausNR, " ")
For i = 0 To UBound(txt)
If IsNumeric(txt(i)) Then
txt(i) = Format(CLng(txt(i)), String(Stellen, "0"))
Else
If IsNumeric(Left(txt(i), 1)) Then
Hnr = Val(txt(i))
txt(i) = Format(Hnr, String(Stellen, "0")) & Replace(txt(i), CStr(Hnr), " ")
End If
End If
Next
HausNrMitNull = Join(txt, " ")
End Function
der Code kommt in ein allgemeines Modul.
Dann kannst du in der Tabelle mit der Formel =HausNrMitNull(A1) den Text in einer Hilfsspalte entsprechend wandeln und nach dieser sortieren, ohne dass der Text in mehrere Spalten aufgebrochen werden muss.
gruß Daniel

Anzeige
AW: Makro für Trennung Str., Hnr und Zusatz
26.05.2014 14:26:18
onkelbobby
Danke für Deinen Tipp.
Hab ich mal probiert. Funktioniert auch soweit. Nur müsste bei dreistelligen Nummern da noch ne 0 vorangestellt werden. Was müsste denn da noch abgeändert werden?
Und: Kann man diesen Code auch direkt in einem anderen Makro (Sub) verwenden?

AW: Makro für Trennung Str., Hnr und Zusatz
26.05.2014 14:47:06
Daniel
Hi
ich habe den zusätlichen Parameter "Stellen" verwendet.
du kannst also diesen mit angeben, um auf drei NK-Stellen zu erweitern:
=HausNrMitNull(A1;3)
oder du setzt diesen gleich im Code auf 3, dann werden immer 3 NK-Stellen verwendet, wenn nichts anderes angegeben wurde:
Function HausNrMitNull(StrasseUndHausNR As String, Optional Stellen As Long = 3) As String
wenn du dir sicher bist, dass du immer nur 3 NK-Stellen haben willst, dann baust du das fix in den Code ein, indem du alle String(Stellen, "0") durch "000" ersetzt und den Parameter aus der Kopfzeile entfernst:
Function HausNrMitNull(StrasseUndHausNR As String) As String
txt(i) = Format(CLng(txt(i)), "000")
txt(i) = Format(Hnr, "000") & Replace(txt(i), CStr(Hnr), " ")
Gruß Daniel

Anzeige
AW: Makro für Trennung Str., Hnr und Zusatz
26.05.2014 15:01:01
Daniel
ja, du kannst diese Funktion auch in einem normalen Makro einsetzen:
Msgbox HausNrMitNull("An der langen Strasse 5a")
Gruß Daniel

AW: Makro für Trennung Str., Hnr und Zusatz
27.05.2014 14:19:49
onkelbobby
Danke für die coolen Tipps. Funktioniert einwandfrei. Jetzt hätte ich nur noch gerne diese Funktion direkt in einem anderen Makro integriert. Diese Makro regelt direkt die Sortierung, vorher müsste also diese Funktion stehen.
In den Zellen C5 bis C... (variabel) steht die Straße die getrennt werden soll. In der Spalte J soll die Hilfsspalte mit den vorstehnden Nullen bei der Straße stehen, nach der dann sortiert werden soll. Ich krieg das leider nicht ganz hin. Im Anhang mal der Code in den die Funktion eingefügt werden soll. Danke noch mal für den (wahrscheinlich letzten) Tipp!
Sub AlphaSort()
Sheets("SAP-Liste").Select
Range("J4").Select
ActiveCell.FormulaR1C1 = "Hnr"
Selection.Sort Key1:=Range("J5"), Order1:=xlAscending, Key2:=Range("C5") _
, Order2:=xlAscending, Key3:=Range("B5"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
Selection.Rows.AutoFit
End Sub

Anzeige
AW: Makro für Trennung Str., Hnr und Zusatz
27.05.2014 14:22:55
onkelbobby
Danke für die coolen Tipps. Funktioniert einwandfrei. Jetzt hätte ich nur noch gerne diese Funktion direkt in einem anderen Makro integriert. Diese Makro regelt direkt die Sortierung, vorher müsste also diese Funktion stehen.
In den Zellen C5 bis C... (variabel) steht die Straße die getrennt werden soll. In der Spalte J soll die Hilfsspalte mit den vorstehnden Nullen bei der Straße stehen, nach der dann sortiert werden soll. Ich krieg das leider nicht ganz hin. Im Anhang mal der Code in den die Funktion eingefügt werden soll. Danke noch mal für den (wahrscheinlich letzten) Tipp!
Sub AlphaSort()
Sheets("SAP-Liste").Select
Range("J4").Select
ActiveCell.FormulaR1C1 = "Hnr"
Selection.Sort Key1:=Range("J5"), Order1:=xlAscending, Key2:=Range("C5") _
, Order2:=xlAscending, Key3:=Range("B5"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
Selection.Rows.AutoFit
End Sub

Anzeige
AW: Makro für Trennung Str., Hnr und Zusatz
27.05.2014 14:40:06
Daniel
Hi
With Range("J5:J" & Cells(Rows.count, 3).end(xlup).row)
.FormulaR1C = "=HausNrMitNull(RC3)
.Formula = .Value
.EntireRow.Sort Key1:=.Cells(1, 1), Order1:=xlascending, Header:=xlno
End With
Funktionsnamen ggf anpassen, so wie du ihn bei dir verwendest.
Gruss Daniel

AW: Makro für Trennung Str., Hnr und Zusatz
27.05.2014 14:55:17
onkelbobby
Hi Daniel,
danke für Deine Antwort. Leider kommt eine Fehlermeldung "Laufzeitfehler 438" in der Zeile
.FormulaR1C = "=HausNrMitNull(RC3) "
Was habe ich falsch gemacht?
Sub AlphaSort()
Sheets("SAP-Liste").Select
Range("J4").Select
ActiveCell.FormulaR1C1 = "Hnr"
With Range("J5:J" & Cells(Rows.Count, 3).End(xlUp).Row)
.FormulaR1C = "=HausNrMitNull(RC3) "
.Formula = .Value
.EntireRow.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
End With
Selection.Sort Key1:=Range("J5"), Order1:=xlAscending, Key2:=Range("C5") _
, Order2:=xlAscending, Key3:=Range("B5"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
Selection.Rows.AutoFit
End Sub

Anzeige
AW: Makro für Trennung Str., Hnr und Zusatz
27.05.2014 15:42:21
onkelbobby
Fehler bemerkt: R1C1!
Vielen Dank!!!

AW: Makro für Trennung Str., Hnr und Zusatz
26.05.2014 14:06:16
onkelbobby
Danke für die prompte Antwort. Diesen Link hatte ich auch schon gefunden. Dabei wird jedoch im obigen Beispiel in einer Spalte "An der Mauer 11" und in der nächsten "A" angezeigt, da noch ein Leerzeichen zwischen Hausnr. und Zusatz ist.
Als Makro hätte ich das gerne, weil immer wieder neue Daten aus einer anderen Datei per Makro geholt und aufbereitet werden. In diesem Zusammenhang möchte ich nicht noch manuell eingreifen müssen.
Ich habe diesen Code gefunden, jedoch mit dem Problem der "Uhrzeitanzeige" (11:00 AM, statt 11 A).
Sub TrenneStrasseNummer()
Dim Zellwert$, Zelle As Range, Zeile%
Sheets("SAP-Liste").Select
For Each Zelle In ActiveSheet.Range("C5:C500")
Zeile = Zeile + 1
Zellwert = ActiveSheet.Range("C" & Zeile + 1).Value
ActiveSheet.Range("K" & Zeile + 1).Value = StrName(Zellwert)
ActiveSheet.Range("L" & Zeile + 1).Value = HsNr(Zellwert)
Next
End Sub

Function StrName(Strasse As String) As String
Dim pos As Integer
Dim Laenge  As Integer
pos = PosHsNrInStrasse(Strasse)
Laenge = Len(Strasse)
If pos > 0 Then
StrName = Trim(Left(Strasse, pos - 1))
Else
StrName = Strasse
End If
End Function

Function HsNr(Strasse As String) As String
Dim pos As Integer
Dim Laenge  As Integer
pos = PosHsNrInStrasse(Strasse)
Laenge = Len(Strasse)
If pos > 0 Then
HsNr = Right(Strasse, Laenge - pos + 1)
Else
HsNr = ""
End If
End Function

Function PosHsNrInStrasse(Strasse As String) As Integer
Dim Zaehler As Integer
Dim Laenge  As Integer
Dim x As String
Laenge = Len(Strasse)
PosHsNrInStrasse = 0
For Zaehler = Laenge To 3 Step -1
x = Mid(Strasse, Zaehler, 1)
If IsNumeric(x) Then
PosHsNrInStrasse = InStr(Strasse, x)
End If
Next
End Function

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige