Autor: Klaus-Dieter Oppermann  --- Aus Excel VBA - Gruppe: Häufige Fragen

Zeilen in Spalten - Gruppen transponieren

Autor: Klaus-Dieter Oppermann - Erstellt: --      - Letzte Revision: --
Zeilen in Spalten

Wenn man Daten aus Fremdsystemen übernimmt, kann es vorkommen, dass sie eine ungünstige Struktur aufweisen. Das kann so aussehen, wie im Beispiel unten. Für eine Verarbeitung in Excel wäre es wünschenswert, die Daten in eine Listenform zu überführen. Transponieren funktioniert bei diesem Aufbau nicht.

Beispieltabelle (Ausschnitt):
 AB
1  
2 Charlotte Cooper
3 Einkaufsmanager
4 49 Gilbert St.
5 EC1 4SD
6 London
7 Großbritannien
8 (71) 555-2222
9 Shelley Burke
10 Bestellungen-Sachbearbeiterin
11 P.O. Box 78934
12 70117
13 New Orleans
14 USA
15 (100) 555-4822
16 Regina Murphy
17 Vertriebsmitarbeiterin
18 707 Oxford Rd.
19 48104
20 Ann Arbor
21 USA
22 (313) 555-5735
 


Für diesen Zweck habe ich ein Makro entwickelt, dass diese Anforderung erfüllt. Um es möglichst universell einsetzbar zu machen, ist es erforderlich, zunächst den zu wandelnden Bereich zu markieren. Wenn das Makro gestartet wird, was zum Beispiel durch eine vom Anwender erstellte Schaltfläche möglich ist, öffnet sich eine Inputbox, in die eingegeben wird, wieviel Zeilen zu einem Datensatz gehören. (Im vorliegenden Beispiel sind das sieben). Nach dem Bestätigen der Eingabe wird das Makro ausgeführt.

So sieht das Ergebnis aus:
 ABCDEFGHI
1         
2 NamePositionStrassePLZOrtLandTelefon 
3 Charlotte CooperEinkaufsmanager49 Gilbert St.EC1 4SDLondonGroßbritannien(71) 555-2222 
4 Shelley BurkeBestellungen-SachbearbeiterinP.O. Box 7893470117New OrleansUSA(100) 555-4822 
5 Regina MurphyVertriebsmitarbeiterin707 Oxford Rd.48104Ann ArborUSA(313) 555-5735 
6 Yoshi NagaseMarketingmanager9-8 Sekimai100TokyoJapan(03) 3555-5011 
7 Antonio del Valle Saavedra ExportadministratorCalle del Rosal 433007OviedoSpanien(98) 598 76 54 
8 Mayumi OhnoMarketingrepräsentant92 Setsuko545OsakaJapan(06) 431-7877 
9 Ian DevlingMarketingmanager74 Rose St.3058MelbourneAustralien(03) 444-2343 
10 Peter WilsonVertriebsmitarbeiter29 King's WayM14 GSDManchesterGroßbritannien(26) 555-4448 
11 Lars PetersonVertriebsagentKaloadagatan 13S-345 67GöteborgSchweden031-987 65 43 
12 Carlos DiazMarketingmanagerAv. das Americanas 12.8905442São PauloBrasilien(11) 555 4640 
13 Petra WinklerVertriebsmanagerTiergartenstraße 510785BerlinDeutschland(010) 9984510 
14 Martin BeinMarketingmanager InternationalBogenallee 5160439FrankfurtDeutschland(069) 992755 
15 Sven PetersenKoordinator AuslandsmärkteFrahmredder 112a27478CuxhavenDeutschland(04721) 8713 
16 Elio RossiVertriebsmitarbeiterViale Dante, 7548100RavennaItalien(0544) 60323 
17 Beate VileidMarketingmanagerHatlevegen 51320SandvikaNorwegen(0)2-953010 
 


Die Überschriften werden vom Makro nicht erzeugt, da diese unbekannt sind Sie müssen vom Anwender per Hand eingegeben werden.
Das Makro arbeitet mit Arrays, was die Ausführung sehr schnell macht.

Das Makro, viel Erfolg damit:

Option Explicit
Sub zeilen_in_spalten()
' Variablen deklarieren
Dim iZeile As Integer ' Zeilenanzahl der Adresse
Dim vArre As Variant ' Array Ausgangsdaten
Dim vArra() As Variant ' Array transponierte Daten
Dim iSzahl As Integer ' Schleifenzähler
Dim iSzaehler As Integer ' Schleifenzähler Ausgangsdaten
Dim iAnz As Integer ' Schleifenzähler 1. Arrayfeld transponierte Daten
Dim iFeld As Integer ' Schleifenzähler 2. Arrayfeld transponierte Daten
' Daten einlesen
On Error GoTo Fehler ' Fehler abfangen
iZeile = InputBox _
("Wieviele Zeilen hat der einzelne Datensatz?") ' Parameter abfragen
If IsEmpty(iZeile) Then Exit Sub ' wenn kein Werte eingegeben, dann Ausstieg
 If Not IsNumeric(iZeile) Then ' wenn keine Zahl eingegeben, dann ...
 MsgBox "Bitte eine Zahl eingeben" ' ... Meldung ausgeben
 Exit Sub ' ... Ausstieg
End If ' Ende der Bedingung
vArre = Selection ' markierten Bereich in Array
' Falsche Eingabe abfangen
If UBound(vArre) Mod iZeile <> 0 Then ' wenn Anzahl markierte Zeilen nicht ohne Rest
 ' durch Zeilen des Einzeldatensatz teilbar, dann ...
 MsgBox _
 "Bitte Eingabe überprüfen," & Chr(10) & _
 "Zeilenzahl passt nicht zur Markierung" ' ... Fehlermeldung ausgeben
 Exit Sub ' ... Ausstieg
End If ' Ende der Bedingung
ReDim vArra(UBound(vArre) / iZeile, iZeile) ' Dimension an Liste anpassen
' Liste neu gliedern
For iSzahl = LBound(vArre) To UBound(vArre) / iZeile ' "äußere" Schleife
 For iFeld = 0 To iZeile - 1 ' "innere" Schleife (Arrayfelder)
 iSzaehler = iSzaehler + 1 ' Zähler plus 1
 vArra(iAnz, iFeld) = vArre(iSzaehler, 1) ' Array mit transponierten Daten füllen
 Next iFeld ' Schleifenzähler plus 1
 If iSzaehler Mod iZeile = 0 Then iAnz = iAnz + 1 ' wenn "Zeile" im Array gefüllt, dann Feldzähler plus 1
Next iSzahl ' Schleifenzähler plus 1
' Neue Tabelle anlegen
ThisWorkbook.Worksheets.Add ' Tabellenblatt zufügen
Range("B3", Cells(UBound(vArre) / _
iZeile + 3, iZeile + 1)) = vArra ' Daten in Tabelle schreiben
' Liste formatieren
With Range("B1", Cells(UBound(vArre) / _
iZeile + 3, iZeile + 1)) ' Bereich definieren
 .WrapText = False ' kein Zeilenumbruch
 .EntireColumn.AutoFit ' optimale Spaltenbreite
End With ' Ende der Definition
Exit Sub ' Fertig - nicht in die Fehlerbehandlung laufen
' Fehlerbehandlung
Fehler: ' bei Fehler ...
 MsgBox Err.Description ' ... Meldung ausgeben
End Sub


Weitere Artikel der Gruppe: Häufige Fragen Aus Excel VBA
Nach oben
ToDo
Google Werbung