Hallo liebe Sachverständige,
Ich würde gern aus Rohdaten eine Adressdatenbank automatisch eine übersichtliche Adressliste in Excel erzeugen.
Die Spalten der Tabelle lauten vereinfacht wie folgt:
Spalte A - Adresskategorie | Spalte B - Bezeichnung | Spalte C - Adresse | Spalte D - Ansprechparter | Spalte E - Kontakt
Beipiel:
Unternehmen | Meyer GmbH | Musterstr. 15 | Herr Meyer | meyer@meyer-gmbh.de
Unternehmen | Meyer GmbH | Bahnhofstr. 1 | Herr Schulz | schulz@meyer-gmbh.de
Verein | Gartenclub e.V. | Kirchgasse 9 | Frau Gäring | info@g-club.de
Verein | Gartenclub e.V. | Kirchgasse 9 | Herr Jaul | info@g-club.de
Behörde | Bauamt | Hauptstr. 102 | Frau Böhm | böhm@bauamt.de
Ich möchte beginnend ab Zeile 10 begrenzt für die Spalten A bis E, dass immer wenn
in Splate B eine Neue Bezeichnung steht, diese durch eine fette Rahmenlinie zwischen
den beiden Zeilen von der vorherigen abgetrennt wird:
Unternehmen | Meyer GmbH | Musterstr. 15 | Herr Meyer | meyer@meyer-gmbh.de
Unternehmen | Meyer GmbH | Bahnhofstr. 1 | Herr Schulz | schulz@meyer-gmbh.de
_________________________________________________________________
Verein | Gartenclub e.V. | Kirchgasse 9 | Frau Gäring | info@g-club.de
Verein | Gartenclub e.V. | Kirchgasse 9 | Herr Jaul | info@g-club.de
_________________________________________________________________
Behörde | Bauamt | Hauptstr. 102 | Frau Böhm | böhm@bauamt.de
_________________________________________________________________
Zwischen den übrigen Zeilen soll nach Möglichkeit eine normale dünne Linie sein.
Meine VBA-Kenntnisse sind leider sehr rudimentär, aber ich habe einen Code gefunden
der fast genau das tut was ich möchte:
1 2 3 4 5 6 7 8 9 10 11 12 13 | Sub Adressgruppen_trennen()
Dim rngBereich As Range
Dim rngZeile As Range
Set rngBereich = Range( "B10:E" & Cells(Rows.Count, 1). End (xlUp).Row)
On Error GoTo Ende
Application.ScreenUpdating = False
For Each rngZeile In rngBereich.Rows
rngZeile.Borders(xlEdgeTop).Weight = 3
rngZeile.Borders(xlEdgeTop).LineStyle = (rngZeile.Cells(1) <> rngZeile.Offset(-1, 0).Cells(1)) * 4119
Next rngZeile
Ende:
Application.ScreenUpdating = True
End Sub
|
Der Linientyp bei diesem Code ist allerdings eine Doppellinie und für die restlichen Zeilen ist gar keine Trennlinie vorgesehen.
Ich habe leider nicht herausfinden können wie man die Linienart ändert. Das eingeben eines anderen Wertes bei ".Weight" bewirkt
zudem auch rein gar nichts.
Über Hilfe bei dem Problem wäre ich sehr dankbar.
Beste Grüße
|