[gelöst] Merge von Feldern per Makro

[akoerber]

Hallo,
ich bekomme folgendes leider nicht hin:

Ich möchte mittels eine Makros

1. feststellen, OB ein Feld in Spalte A, von dem aus ich den Makro aufrufe, über mehr als eine Zeile geht; wenn ja
   1. feststellen, über WELCHE Zeilen das verbundene Feld in Spalte A geht (z.B. A12 -A14),
   2. Dann in diesen ZEILEN die Felder der Spalten K und L (also im Beispiel K12 - L14) so mergen, dass die Inhalte der unteren Zeilen in die oberen übertragen werden (Option 1 des Zusammenführen-Befehls bei manueller Ausführung).
   3. Schließlich die Zeilen außer der ersten löschen
2. wenn nein, einen Schritt nach unten gehen und das ganze wiederholen.

Mein Ansatz wäre:

1. im Feld in Zeile 1 die Zeilennummer feststellen; in eine Variable Row1 schreiben
2. einen Schritt nach unten gehen; auch hier die Zeilennummer feststellen und in eine Variable Row2 schreiben
3. wenn die Subtraktion >0 ergibt:
   1. einen Befehl Merge $KRow1$LRow2 ausführen [wie lautet der? Wie wird die Adresse übergeben; wie wird angegeben, dass der Inhalt nach oben bewahrt werden soll? ich habe gefunden: dispatcher.executeDispatch(document, ".uno:MergeCells", "", 0, "K"+row1+"L"+row2), aber der hinter Teil ist sicher falsch]
   2. einen Befehl zum Löschen der Zeilen von Row1+1 bis Row2 ausführen [auch hier: wie geht das?]
4. wenn sie es nicht tut: einen Schritt nach unten; Macro neu aufrufen

Mein derzeitiger Versuch sieht so aus:

Code: Alles auswählen

sub test2

row1 = ThisComponent.CurrentSelection.rows(0)

'MsgBox ("Selected: "+row)


rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "By"
args1(0).Value = 1
args1(1).Name = "Sel"
args1(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args1())

rem ---------------------------------------------------------------------------------
row2 = ThisComponent.CurrentSelection.rows(0)
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "MoveContents"
args2(0).Value = false
dispatcher.executeDispatch(document, ".uno:MergeCells", "$K"+row1+"$L"+row2, 0, args2())


end sub

aber ich bekomme immer einen Fehler "falsches Argument" in der dispatcher-Zeile.

Ideen?
Dank im Voraus

[mikele]

Hallo,

Schließlich die Zeilen außer der ersten löschen

Warum willst du dann die Zellen erst verbinden?

[akoerber]

Die Tabelle (nicht von mir erstellt) enthält "Fälle", die nur aus einer Zeile bestehen, und solche, in denen in einigen Spalten mehrere Zeilen mit Daten gefüllt sind, die zusammen gehören. Das Feld in Spalte A geht jeweils über den ganzen Fall (mal 2, mal 7 Zeilen).

Ich muss die Tabelle nun sortierbar machen.
Dazu will ich
1. in den Fällen Spalten mit mehreren gefüllten Zeilen die entsprechenden Felder ZUSAMMENFÜHREN und dabei die Daten der unteren Zeilen in die oberste übernehmen (das Menü ZUSAMMENFÜHREN bietet das als erste Option an).

Zwischenablage_07-06-2025_01.jpg (40.12 KiB) 235 mal betrachtet

2. DANN die Felder wieder trennen, so das nur noch 1 gefüllte Zeile (mit allen Informationen aus der Spalte nun in dem dieser Zeile) und darunter entsprechend Leerzeilen entstehen, die sich später "wegsortieren".

Das kann man ganz gut programmieren. ABER: Immer an der Stelle, wo der MERGE aufgerufen wird, kommt das oben gezeigte Dialogfeld, in dem die Option gewählt werden muss, dass der Inhalt nach oben bewegt werden soll.


Inzwischen sieht das so aus:

Code: Alles auswählen

sub verb5
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem -------------------
oZelladresse=ThisComponent.CurrentSelection.CellAddress
row1=oZelladresse.Row+1
'MsgBox ("Selected: "+row1)


rem ----------------------------------------------------------------------
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "By"
args1(0).Value = 1
args1(1).Name = "Sel"
args1(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args1())

rem -------------------
oZelladresse=ThisComponent.CurrentSelection.CellAddress
row2=oZelladresse.Row
'MsgBox ("Selected: "+row2)


rem -------------------
rowdiff=row2-row1
'MsgBox ("Difference: "+rowdiff)

rem ----------------------------------------------------------------------

dim args2(1) as new com.sun.star.beans.PropertyValue
args2(0).Name = "By"
args2(0).Value = 1
args2(1).Name = "Sel"
args2(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoUp", "", 0, args2())

rem ----------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "By"
args3(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoRightSel", "", 0, args3())

rem ----------------------------------------------------------------------
dim args4(0) as new com.sun.star.beans.PropertyValue
args4(0).Name = "By"
args4(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoRightSel", "", 0, args4())

rem ----------------------------------------------------------------------
dim args5(0) as new com.sun.star.beans.PropertyValue
args5(0).Name = "By"
args5(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoRightSel", "", 0, args5())

rem ----------------------------------------------------------------------
dim args6(0) as new com.sun.star.beans.PropertyValue
args6(0).Name = "By"
args6(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoRightSel", "", 0, args6())

rem ----------------------------------------------------------------------
dim args7(0) as new com.sun.star.beans.PropertyValue
args7(0).Name = "By"
args7(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoRightSel", "", 0, args7())

rem ----------------------------------------------------------------------
dim args8(0) as new com.sun.star.beans.PropertyValue
args8(0).Name = "By"
args8(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoRightSel", "", 0, args8())

rem ----------------------------------------------------------------------
dim args9(0) as new com.sun.star.beans.PropertyValue
args9(0).Name = "By"
args9(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoRightSel", "", 0, args9())

rem ----------------------------------------------------------------------
dim args10(0) as new com.sun.star.beans.PropertyValue
args10(0).Name = "By"
args10(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoRightSel", "", 0, args10())

rem ----------------------------------------------------------------------
dim args11(0) as new com.sun.star.beans.PropertyValue
args11(0).Name = "By"
args11(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoRightSel", "", 0, args11())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:SplitCell", "", 0, Array())

rem ----------------------------------------------------------------------
dim args13(1) as new com.sun.star.beans.PropertyValue
args13(0).Name = "By"
args13(0).Value = 1
args13(1).Name = "Sel"
args13(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args13())

rem ----------------------------------------------------------------------
dim args14(1) as new com.sun.star.beans.PropertyValue
args14(0).Name = "By"
args14(0).Value = 1
args14(1).Name = "Sel"
args14(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args14())

rem ----------------------------------------------------------------------
dim args15(1) as new com.sun.star.beans.PropertyValue
args15(0).Name = "By"
args15(0).Value = 1
args15(1).Name = "Sel"
args15(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args15())

rem ----------------------------------------------------------------------
dim args16(1) as new com.sun.star.beans.PropertyValue
args16(0).Name = "By"
args16(0).Value = 1
args16(1).Name = "Sel"
args16(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args16())

rem ----------------------------------------------------------------------
dim args17(1) as new com.sun.star.beans.PropertyValue
args17(0).Name = "By"
args17(0).Value = 1
args17(1).Name = "Sel"
args17(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args17())

rem ----------------------------------------------------------------------
dim args18(1) as new com.sun.star.beans.PropertyValue
args18(0).Name = "By"
args18(0).Value = 1
args18(1).Name = "Sel"
args18(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args18())

rem ----------------------------------------------------------------------
dim args19(1) as new com.sun.star.beans.PropertyValue
args19(0).Name = "By"
args19(0).Value = 1
args19(1).Name = "Sel"
args19(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args19())

rem ----------------------------------------------------------------------
dim args20(1) as new com.sun.star.beans.PropertyValue
args20(0).Name = "By"
args20(0).Value = 1
args20(1).Name = "Sel"
args20(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args20())

rem ----------------------------------------------------------------------
dim args21(1) as new com.sun.star.beans.PropertyValue
args21(0).Name = "By"
args21(0).Value = 1
args21(1).Name = "Sel"
args21(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args21())

rem ----------------------------------------------------------------------
dim args22(1) as new com.sun.star.beans.PropertyValue
args22(0).Name = "By"
args22(0).Value = 1
args22(1).Name = "Sel"
args22(1).Value = false

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args22())

rem ----------------------------------------------------------------------
dim args23(0) as new com.sun.star.beans.PropertyValue
args23(0).Name = "By"
args23(0).Value = 1

dispatcher.executeDispatch(document, ".uno:GoRightSel", "", 0, args23())

rem ----------------------------------------------------------------------
dim args24(0) as new com.sun.star.beans.PropertyValue
args24(0).Name = "By"
args24(0).Value = rowdiff

dispatcher.executeDispatch(document, ".uno:GoDownSel", "", 0, args24())

rem ----------------------------------------------------------------------
rem dispatcher.executeDispatch(document, ".uno:MergeCells", "", 0, Array())

rem ----------------------------------------------------------------------
dim args26(0) as new com.sun.star.beans.PropertyValue
args26(0).Name = "MoveContents"
args26(0).Value = false

dispatcher.executeDispatch(document, ".uno:MergeCells", "", 0, args26())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:SplitCell", "", 0, Array())


end sub

Im vorletzten Block (uno:MergeCells) fehlt mir die Möglichkeit der Auswahl bzw. der Untderdrückung des Dialogs mit Wahl der ersten Option. Der letzte Block (uno:SplitCell) wird so gar nicht mehr ausgeführt.

[mikele]

Hallo,

Ich muss die Tabelle nun sortierbar machen.

Wäre es da nicht einfacher/sinnvoller die "Felder" der Spalte zu trennen, d. h. die Zellen zu trennen und jeweils mit dem Inhalt der ersten Zelle zu füllen?

[akoerber]

Es liegen ja getrennte Felder vor, deren Inhalt aber in der ersten (obersten) von ihnen zusammengeführt werden soll.

Zwischenablage_07-07-2025_01.jpg (46.4 KiB) 160 mal betrachtet

Die Angaben der Felder unter dem blau umrandeten Feld sollen mit in dieses Feld übernommen werden.
Es gibt Fälle, das sind es 2, bis zu etwa 7 solcher Zeilen, die vorne verbunden sind.

Im Ergebnis soll jeder "Fall" nur eine Zeile umfassen, aber die in getrennten Feldern in Spalte K enthaltenen Angaben alle im verbleibenden Feld der Spalte K behalten. Um sie zu trennen, habe ich eine Spalte L mit jeweils dem Inhalt "; " erstellt. Wenn nun die Felder eines Falles in Spalte K und L gemergt werden, werden die Inhalte zusammengeführt. Dazu aber muss - auch bei Aufruf per Macro - jeweils per Hand bestätigt werden, dass Option 1 Übernahme in das erste Feld gewünscht ist.

Danach kann man das Feld wieder trennen, so dass der Inhalt in der ersten Zeile des Falles verbleibt und die weiteren Zeilen gelöscht werden können.

[mikele]

Hallo,
also geht es nur um die Spalte K, deren Elemente (mit ";" getrennt) zusammengefasst werden sollen - richtig?

[akoerber]

ja, aber wie viele untereinander liegende Felder in K zusammengefasst werden sollen, ergibt sich aus Spalte A. Dort sind die Zeilen eines Falles zu einem Feld zusammengeführt. Manche Fälle erstrecke sich über 2, andere über bis zu sieben Zeilen.
Wenn man in A steht, kann man errechnen, wie viele man in K zusammenfassen muss, in meinem Ansatz, in dem die Zeilennummer des Feldes in A in eine Variable speichert (das ist die Nummer der ersten Zeile des Falles, dann einen Schritt nach unten (zum nächsten Fall), auch dessen oberste Zeile speichert, und aus beiden den Zeilenumfang des Falles zu berechnen. Wenn man dann zu K geht, kann man mit SELECT und herunter gehen (sowie eine nach rechts für die Trenner) die zusammenzufassenden Felder ermitteln

[mikele]

Hallo,
mit folgendem Makro werden die Inhalte der Zellen der Spalte K zusammengetragen, wenn die entsprechenden Zellen in A verbunden sind und in die erste Zeile gesetzt. Die anderen Zeilen werden gelöscht.

Code: Alles auswählen

Sub zellbereich_unmerge

	'Zugriff auf das Dokument
	oDoc=ThisComponent
	'Zugriff auf die erste Tabelle
	oTab=oDoc.Sheets(0)
	'Gehe zur letzten benutzten Zelle
	oCur=oTab.createCursorByRange(oTab.Columns(0))
	oCur.gotoEndOfUsedArea(False)
	vonzeile=oCur.RangeAddress.StartRow
	'Durchlaufe die Spalte A bis zum Anfang und beseitige alle verbundenen Bereiche
	do while vonzeile>-1
		zelle=oTab.getCellByPosition(0,vonzeile)
		oCur=oTab.createCursorByRange(zelle)
		oCur.collapseToMergedArea()
		vonzeile=oCur.RangeAddress.StartRow
		biszeile=oCur.RangeAddress.EndRow
		zusammen=""
		if biszeile>vonzeile then
			for i=0 to biszeile-vonzeile
				if otab.getCellByPosition(10,vonzeile+i).String<>"" then
					zusammen=zusammen & otab.getCellByPosition(10,vonzeile+i).String & "; "
				end if
			next
			if zusammen<>"" then
				zusammen=left(zusammen,len(zusammen)-2)
			end if
			otab.getCellByPosition(10,vonzeile).String=zusammen
			oTab.Rows.removeByIndex(vonzeile+1,biszeile-vonzeile)
		end if
		vonzeile=vonzeile-1
	loop
End Sub

[akoerber]

Danke. Dieser Makro durchläuft die ganze Tabelle selbstständig?
Das ist klasse,

Ich sehe, Du machst das, indem Du den Inhalt der Zeilen herauskopierst, zusammenfügst und wieder einträgst, d.h. Du nutzt die MERGE Funktion gar nicht.

Nun würde mich aber für weitere Aufgaben trotzdem interessieren, ob man den MERGE Befehl, wie ich ihn genutzt habe auch bei einem Aufruf per Makro dazu bringen kann, ohne die manuelle Abfrage zu arbeiten und die Inhalte alle nach oben zu verschieben.
Ich brauche das für eine weitere Tabelle, bei der ich entsprechende Aufgabe Zeile für Zeile einzeln aufrufen muss, weil zuvor enthaltene Fehler korrigiert werden müssen (etwa noch im Vornamenfeld mit enthaltene akademische Titel). Das muss einzeln gemacht werden.
Sonst muss ich mir das auch mit Deiner Technik zusammen basteln. Aber mich würde das doch interessieren, ob das überhaupt geht.

[mikele]

Hallo,

bei einem Aufruf per Makro dazu bringen kann, ohne die manuelle Abfrage zu arbeiten

Nicht das ich wüsste.

bei der ich entsprechende Aufgabe Zeile für Zeile einzeln aufrufen muss

Dann vereinfacht sich das Makro zu

Code: Alles auswählen

Sub zellbereich_unmerge2

	oDoc=ThisComponent
	oSel=oDoc.CurrentSelection
	oTab=oSel.Spreadsheet
	oCur=oTab.createCursorByRange(oSel)
	oCur.collapseToMergedArea()
	vonzeile=oCur.RangeAddress.StartRow
	biszeile=oCur.RangeAddress.EndRow
	zusammen=""
	if biszeile>vonzeile then
		for i=0 to biszeile-vonzeile
			if otab.getCellByPosition(10,vonzeile+i).String<>"" then
				zusammen=zusammen & otab.getCellByPosition(10,vonzeile+i).String & "; "
			end if
		next
		if zusammen<>"" then
			zusammen=left(zusammen,len(zusammen)-2)
		end if
		otab.getCellByPosition(10,vonzeile).String=zusammen
		oTab.Rows.removeByIndex(vonzeile+1,biszeile-vonzeile)
	end if
End Sub