Tabelle von Flach nach Multiple transponieren
Flach
ich habe eine nette Excel Tabelle mit ca. 137000 Zeilen und 10 Spalten.
SUPPLIER_AID KEYWORD1 KEYWORD2 KEYWORD3 KEYWORD4 KEYWORD5 KEYWORD6 KEYWORD7 KEYWORD8 KEYWORD9 000000015010 agujas corona caquillo anillo disco axial rodillos levas
000000018010 rodamiento especial Taylor
000000112010 agujas corona caquillo anillo disco axial rodillos levas
In jeder Zeile steht ein Artikel, in den Spalten die Keywords dazu (verschiedene Anzahlen)
Diese Daten brauche ich jedoch multiple, d.h. wenn 1 Artikel 5 Keywords hat muss dieser dann in 5 Zeilen
erscheinen mit jeweils einem Keyword dahinter.
also so:
SUPPLIER_AID_MULTI KEYWORD
000000015010 agujas
000000015010 corona
000000015010 caquillo
000000015010 anillo
000000015010 disco
000000015010 axial
000000015010 rodillos
000000015010 levas
das ganze soll in ein neues Tabellenblatt direkt einkopiert werden "Keyword_multiple"
Hier mal mein Script dazu, welches im Moment die Werte einfach rechts neben die Tabelle _
schreibt:
Sub Transponieren()
' Transponieren Makro
' 23.02.2012 Transponieren der Keywords im Spanischen Extract
' Automatische Bestimmung der Spalten und Zeilen für die Zähler
' Danach liegen die Daten als Multiple Werte vor
Dim lngSpaltenZähler As Long
Dim lngZeilenzähler As Long
Dim lngLoopCounter As Long
Dim lngCurrentPosition As Long ' --- für die aktuelle _
Position fürs nächste Transponieren
Dim lngAnzahlZeilen As Long
Dim strArtikelnummer As String
Dim strColumnAid As String
Dim strColumnKeyword As String
strColumnAid = "M" ' --- Spalte Supplier AID _
_
_
_
im BasisBlatt
strColumnKeyword = "N" ' --- Spalte neue Keywords _
_
_
_
im BasisBlatt
lngAnzahlZeilen = Cells(Rows.Count, "A").End(xlUp).Row ' --- Wieviele Zeilen _
sind im ExcelSheet ?
lngCurrentPosition = 2 ' --- Startwert für _
transponierte Zellen
MsgBox "Es werden für: " & lngAnzahlZeilen & " die Keywords multiple generiert, das dauert _
etwas "
' Überschriften setzen
Range(strColumnAid & "1").Formula = "SUPPLIER_AID_MULTI"
Range(strColumnKeyword & "1").Formula = "KEYWORD"
' Spalte M auf Text setzen
Columns(strColumnAid & ":" & strColumnAid).Select
Selection.TextToColumns Destination:=Range(strColumnAid & "1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 2), TrailingMinusNumbers:=True
' Anzahl gefüllter Spalten in der Zeile feststellen für Anzahl der Zeilen in die die _
Artikelnummer kopiert werden muss
For lngLoopCounter = 2 To lngAnzahlZeilen
lngSpaltenZähler = Application.CountA(Range("B" & lngLoopCounter & ":K" & lngLoopCounter))
Range("B" & lngLoopCounter & ":K" & lngLoopCounter).Copy
' In Spalte N2 kopieren weil leer
Range("N" & lngCurrentPosition).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:= _
False, Transpose:=True
' aktuelle Artikelnummer vor den Transponierten Bereich kopieren
strArtikelnummer = "'" & Range("A" & lngLoopCounter) ' --- mit dem _
Hochkomma wegen Typenumwanndlung führende 0
Range(strColumnAid & lngCurrentPosition & ":" & strColumnAid & _
lngCurrentPosition + lngSpaltenZähler - 1).FormulaR1C1 = strArtikelnummer
lngCurrentPosition = (lngCurrentPosition + lngSpaltenZähler) ' --- auf nächste _
Position für Transponieren zeigen
Next
MsgBox ("Es wurden für: " & lngAnzahlZeilen & " die multiplen Keywords erzeugt ")
'-------------------------- Hier wirds etwas unschöner ;-) ----------------------------------- _
_
_
_
Columns(strColumnAid & ":" & strColumnKeyword).Select
Selection.Copy
Sheets("Keywords_Multi").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' --------------------------------------------------------------------------------------------- _
_
_
_
End Sub
Wie gesagt der Konten kommt ins Hirn wenn ich überlege wie die Daten DIREKT ins neue Tabellenblatt kommen.
Grüße
Martin