Zeilen in Spalte jeweils mit Spaltenüberschrift

[zoliverz]

Bin jetzt den zweiten Tag an einem Problem und finde keine Lösung. Bin über alle möglichen Funktionen gestolpert- aber kriegs nicht hin. Folgendes Problem: Habe folgende Tabelle mit
Kundennummer Firma Vorname Name Strasse PLZ Ort
die Werte sind alle in Zeilen. Jetzt sollen die Zeilen in Spalten erscheinen, wobei in der 1. Spalte die jeweiligen Spaltenüberschriften stehen sollen.

Die Tabelle soll so aussehen
Firma A
Vorname Heinz
Name Muster
Strasse ...
PLZ ...
Ort ...
Firma B
Vorname Marion
Name Hinkel
Strasse ...
PLZ ...
Ort ...
usw.
Firma

in einer 3. Spalte soll noch die Kundennummer stehen, die ja für einen Datensatz immer konstant ist. Habt Ihr eine Idee?

[zoliverz]

Ich will mein Problem etwas einfacher beschreiben.
meine Tabelle:
A B C
3 5 1
5 2 6
7 1 0

soll in diese Form gebracht werden (für einige hundert Datensätze)
A 3
B 5
C 1
A 5
B 2
C 6
A 7
B 1
C 0

[bst]

Morgen,

Du könntest das mal so versuchen. Das Ergebnis wird rechts neben die Quelldaten kopiert.

Den Code in ein Modul kopieren und dann das Makro Main ausführen.

cu, Bernd
--

Code: Alles auswählen

REM  *****  BASIC  *****

Sub Main
   dim oSheet as Object, oLastCell as Object, iMaxRow as Long, iMaxCol as Long
   dim i as Long, j As Long, k as Long
   
   oSheet = ThisComponent.CurrentController.getActiveSheet()
   oLastCell = getLastCell(oSheet)
   iMaxRow = oLastCell.endRow
   iMaxCol = oLastCell.endColumn
   k = 0
   for i = 1 to iMaxRow
      for j = 0 To iMaxCol
         prcCopyValue oSheet.getCellByPosition(j, 0), oSheet.getCellByPosition(iMaxCol + 2, k)
         prcCopyValue oSheet.getCellByPosition(j, i), oSheet.getCellByPosition(iMaxCol + 3, k)
         k = k + 1
	  next
   next	
End Sub

Function getLastCell(Optional oStartSheet as object) as object
	dim oSheet as object
	dim oCellCursor as object

	if isMissing(oStartSheet) Then 
		oSheet = ThisComponent.CurrentController.ActiveSheet
	else
		oSheet = oStartSheet
	endif
	oCellCursor = oSheet.createCursor
    oCellCursor.GotoEndOfUsedArea(False)
	getLastCell = oCellCursor.getRangeAddress()
End Function

Sub prcCopyValue(oSrcRange as Object, oDstRange as Object)
	dim arData as Variant
	
	arData = oSrcRange.getDataArray()
	oDstRange.setDataArray(arData)
End Sub

[zoliverz]

Bernd, tausend Dank! Echt stark. Sorry, Ich hatte das Problem vereinfacht dargestellt, weil ich dachte, dass ich die Lösung dann selbst modifizieren könnte. Nur bei dem Code weiss ich leider nicht, wie das geht.
Wie kann in deinen Code noch die ID eingebaut werden, die in der 3. Spalte erscheinen soll?

ID A B C
1 3 5 1
2 5 2 6
3 7 1 0

soll werden:

ID
A 3 1
B 5 1
C 1 1
A 5 2
B 2 2
C 6 2
A 7 3
B 1 3
C 0 3

[zoliverz]

"ID" ist mir verutscht, wollte ich über die 3. Spalte schreiben.

[Gert Seler]

Hallo zoliverz,
der vorschlag von "Rocko" ist schon o.k., hier nochmal :

Hierzu die Zellen markieren, die anders organisiert werden sollen, und mit [Strg]+[C] in die Zwischenablage kopieren. Danach den Mauszeiger in einem leeren Tabellenblatt in eine leere Zelle platzieren und den Befehl “Bearbeiten | Inhalte einfügen” aufrufen. Im folgenden Fenster die Option “Transponieren” wählen, Häkchen setzen und mit OK bestätigen. Die Daten werden daraufhin mit vertauschten Zellen und Spalten eingefügt.

So funktioniert es.

mfg
Gert

[zoliverz]

das ist richtig. Ich hatte das mit dem Transponieren bereits versucht. Trotzdem danke für den Tipp.

[bst]

Hallo,

ändere mal den Start der j-Schleife auf 1:

Code: Alles auswählen

      for j = 1 To iMaxCol

und füge eine Kopier-Zeile hinzu:

Code: Alles auswählen

         prcCopyValue oSheet.getCellByPosition(0, i), oSheet.getCellByPosition(iMaxCol + 4, k)

HTH, Bernd

[zoliverz]

vielen Dank! es funktioniert.