AW: AdressListe umgestalten
28.04.2012 08:48:59
fcs
Hallo Pavel,
den Hinweis von Erich solltest du Dir wirklich zu Herzen nehmen.
Falls deine Frage in der aktuellen Forumsliste nicht mehr vorhanden ist, dann kannst unter "Deine Beiträge" prüfen, ob noch Antworten eingegangen sind.
Falls dann weitere Fragen sind, dann im neuen Thread bitte einen Link zur archivierten Frage einfügen.
Ich kannte deine ursprüngliche Frage und insbesondere Reihards Antwort nicht und hab jetzt auch Zeit für eine Lösung investiert.
Vom Ansatz her ähnlich wie Reinhards, jedoch mit Hilfsspalten statt Namen mit Formeln.
Tabellenblattname: Tabelle1
A B C D E F G H
1 Vorname Nachname Telefon Zeile 1 Bereich 1
2 Hans Muster 0876665544 1 F1:G4 Vorname Hans 1
3 Franz Beispiel3 5 F5:G7 Nachname Muster 1
4 Franz Beispiel 0321110033 8 F8:G12 Telefon 0876665544 1
5 2
6 Vorname Franz 2
7 Nachname Beispiel3 2
8 3
9 Vorname Franz 3
10 Nachname Beispiel 3
11 Telefon 0321110033 3
Benutzte Formeln:
A2: =WENN(ISTNV(SVERWEIS(A$1;INDIREKT($E2);2;FALSCH));"";SVERWEIS(A$1;INDIREKT($E2);2;FALSCH))
A3: =WENN(ISTNV(SVERWEIS(A$1;INDIREKT($E3);2;FALSCH));"";SVERWEIS(A$1;INDIREKT($E3);2;FALSCH))
A4: =WENN(ISTNV(SVERWEIS(A$1;INDIREKT($E4);2;FALSCH));"";SVERWEIS(A$1;INDIREKT($E4);2;FALSCH))
B2: =WENN(ISTNV(SVERWEIS(B$1;INDIREKT($E2);2;FALSCH));"";SVERWEIS(B$1;INDIREKT($E2);2;FALSCH))
B3: =WENN(ISTNV(SVERWEIS(B$1;INDIREKT($E3);2;FALSCH));"";SVERWEIS(B$1;INDIREKT($E3);2;FALSCH))
B4: =WENN(ISTNV(SVERWEIS(B$1;INDIREKT($E4);2;FALSCH));"";SVERWEIS(B$1;INDIREKT($E4);2;FALSCH))
C2: =WENN(ISTNV(SVERWEIS(C$1;INDIREKT($E2);2;FALSCH));"";SVERWEIS(C$1;INDIREKT($E2);2;FALSCH))
C3: =WENN(ISTNV(SVERWEIS(C$1;INDIREKT($E3);2;FALSCH));"";SVERWEIS(C$1;INDIREKT($E3);2;FALSCH))
C4: =WENN(ISTNV(SVERWEIS(C$1;INDIREKT($E4);2;FALSCH));"";SVERWEIS(C$1;INDIREKT($E4);2;FALSCH))
D2: =VERGLEICH(ZEILE()-1;H:H;0)
D3: =VERGLEICH(ZEILE()-1;H:H;0)
D4: =VERGLEICH(ZEILE()-1;H:H;0)
E2: ="F" & D2 & ":G" & WENN(E3="";D2+4;D3-1)
E3: ="F" & D3 & ":G" & WENN(E4="";D3+4;D4-1)
E4: ="F" & D4 & ":G" & WENN(E5="";D4+4;D5-1)
H1: =ZÄHLENWENN($F$1:F1;"")
H2: =ZÄHLENWENN($F$1:F2;"")
H3: =ZÄHLENWENN($F$1:F3;"")
H4: =ZÄHLENWENN($F$1:F4;"")
H5: =ZÄHLENWENN($F$1:F5;"")
H6: =ZÄHLENWENN($F$1:F6;"")
H7: =ZÄHLENWENN($F$1:F7;"")
H8: =ZÄHLENWENN($F$1:F8;"")
H9: =ZÄHLENWENN($F$1:F9;"")
H10: =ZÄHLENWENN($F$1:F10;"")
H11: =ZÄHLENWENN($F$1:F11;"")
Das Problem mit dem Verlust der Nullen in der Orts/Land-Vorwahl kannst du umgehen, wenn du beim Öffnen/Importieren der TXT-Datei im Schritt 3 des Textkonvertierungs-Assistenten das Format der Spalten von "Standard" in "Text" änderst.
Alternativ kan man solche Listen auch per Makro umstellen.
Gruß
Franz
Sub Adressliste_umstellen()
Dim wksAlt As Worksheet, wksNeu As Worksheet, wbNeu As Workbook
Dim lngZeile_A As Long, lngZeile_N As Long
Const lngSpalteFeld As Long = 6 'Spalte F - Spalte mit den Feldnamen
Set wksAlt = ActiveSheet 'Tabellenblatt mit den Ausgangsdaten
With wksAlt
'Prüfen, ob Daten vorhanden in Spalte F
lngZeile_A = .Cells(.Rows.Count, lngSpalteFeld).End(xlUp).Row
If lngZeile_A = 1 Then
MsgBox "Im aktiven Tabellenblatt sind keine Daten in Spalte F vorhanden", _
vbInformation + vbOKOnly, "Adressliste umstellen"
GoTo Beenden 'Keine Daten in Spalte F
End If
Application.ScreenUpdating = False
'Neue Datei mit einem Tabellenblatt anlegen
Set wbNeu = Workbooks.Add(Template:=xlWBATWorksheet)
Set wksNeu = wbNeu.Worksheets(1)
With wksNeu
lngZeile_N = 1
'Spaltentitel für umgestellte Liste
.Cells(lngZeile_N, 1) = "Vorname"
.Cells(lngZeile_N, 2) = "Nachname"
.Cells(lngZeile_N, 3) = "Telefon"
End With
'Prüfen Zelle F1 - sollte normalerweise leer sein
If Trim(.Cells(1, lngSpalteFeld)) "" Then
lngZeile_N = lngZeile_N + 1
End If
For lngZeile_A = 1 To lngZeile_A
'Inhalt in Spalte F prüfen
With .Cells(lngZeile_A, lngSpalteFeld)
If Trim(.Text) = "" Then 'leere Zeile
'nächster Datensatz
'Prüfen, ob Zeile unterhalb die Zeile nicht leer ist
If Trim(.Offset(1, 0).Text) "" Then
lngZeile_N = lngZeile_N + 1
End If
ElseIf InStr(1, .Value, "Vorname") > 0 Then
wksNeu.Cells(lngZeile_N, 1).Value = .Offset(0, 1).Text
ElseIf InStr(1, .Value, "Nachname") > 0 Then
wksNeu.Cells(lngZeile_N, 2).Value = .Offset(0, 1).Text
ElseIf InStr(1, .Value, "Telefon") > 0 Then
With .Offset(0, 1)
'das zusätzlich vorangestellte "'" schützt führende Nullen der Telefonnummer
wksNeu.Cells(lngZeile_N, 3).Value = IIf(IsNumeric(.Value), "'", "") & .Text
End With
End If
End With
Next lngZeile_A
End With
With wksNeu
'Spalte A bis C: Spaltenbreite anpassen
.Range(.Columns(1), .Columns(3)).AutoFit
'Tabellenblatt umbenennen
.Name = "Adressliste"
End With
'Fenster unterhalb von A1 fixieren
With ActiveWindow
.ScrollColumn = 1
.ScrollRow = 1
Range("A2").Select
.FreezePanes = True
End With
MsgBox "Fertig", vbInformation + vbOKOnly, "Adressliste umstellen"
Beenden:
Application.ScreenUpdating = True
Set wksNeu = Nothing: Set wksAlt = Nothing: Set wbNeu = Nothing
End Sub