LibreOffice-Forum

Code: Alles auswählen

  Grünberg	Tag 1	Tag 2	Tag 3	...
  Holzhausen	Tag 7	Tag 8	Tag 9	...  

Code: Alles auswählen

Sub SPALTENTRANSPONIEREN
' Name geändet da Dein Makro parallel noch vorhanden
Dim oDoc as Object
Dim oSheet1 as Object, oSheet2 as Object
Dim oRange1 as Object, oRange2 as Object
Dim oRow1 as Object

Dim mArr1() as Variant, mArr2() as Variant

REM & = Long
Dim nLastRow&
Dim nCnt1&, nCnt2&
Dim nCntX&, nCntY&
	
	' Referenz dieses Dokument
	oDoc =ThisComponent
			
		' Referenz: Tabellenblatt 1
		' Hier ggf. Tabellenblattname anpassen
		oSheet1 =oDoc.Sheets().getByName("Tabelle6")

		' Referenz: Zielbereich der transponierten Daten
		' Spalte B  bis G = 6 Spalten
		' ggf. die Zeilenanzahl vergrößern → z.B.: G5000
		oRange2=oSheet1.getCellRangeByName("I2:ZZ3100")  ' "B2:G1000"

		' Array für die transponierten Daten auf Basis des Zellbereichs "oRange2" dimensionieren
		mArr2()=oRange2.getDataArray()
			
		' Arrayinhalt löschen, nur für den Fall, dass in
		' im Bereich oRange2 Daten enthalten sind.
		For  nCnt1 = 0 To UBound(mArr2())
			For nCnt2 = 0 To 5
				mArr2(nCnt1)(nCnt2)=""
			Next
		Next
'xray osheet1
	' letze befüllte Zeile in Spalte A ermitteln
    oRow1 = oSheet1.Columns(7).queryEmptyCells()  ' ANPASSEN an die Spaltennummer 7=H
'xray oRow1
'xray oRow1(oRow1.Count-1)
'xray oRow1(oRow1.Count-1).RangeAddress
    nLastRow1 = oRow1(oRow1.Count-1).RangeAddress.StartRow-1
'xray nLastRow1

REM Hinweis zur Analyse dieser Codezeile:
REM		getCellRangeByPosition(0,1,0,nLastRow)
			' ( nLeft as long = 0	→ Spalte A
			'	nTop as long = 1 →	Zeile 2
			'	nRight as long = 0	→ Spalte A
			'	nBottom as long = → nLastRow (letzte Zeile in Spalte A)
			oRange1=oSheet1.getCellRangeByPosition(7,1,7,nLastRow1) '(0,1,0,..)
'xRay oRange1
			' Daten aus Spalte A in Array einlesen
			mArr1()=oRange1.getDataArray()

REM Array transponieren	
    For nCnt1 = 0 To UBound(mArr1())
			mArr2(nCntY)(nCntX) = mArr1(nCnt1)(0)

REM		betrifft Array → mArr()	
	        nCntX=nCntX+1
        	' Wenn SpaltenzählerX = 6, dann SpaltenzählerX = 0
	        ' UND ZeilenzählerY + 1
	        ' 171 Werte gehören zu einem Block !
		If nCntX = [b]171[/b] Then
		        nCntX=0
		        nCntY=nCntY+1
		End If
    Next