OpenOffice.info

sub merge_gleiche_Werte
odoc = ThisComponent
osheet = odoc.sheets(0) '1. Tabellenblatt

	do while osheet.getcellbyposition(0,i).value > 0
		startz = i
		x = osheet.getcellbyposition(0,i).value
		i = i +1
		do while osheet.getcellbyposition(0,i).value = x
			i = i +1
		loop
'evtl. vorhandene Zusammenfassungen im Bereich aufheben
		osheet.getcellrangebyposition(0,startz,0,i -1).merge(false)
'und den ganzen Bereich zusammenfassen
		osheet.getcellrangebyposition(0,startz,0,i-1).merge(true)
	loop
end sub
	

Global oListener As Object
Global ocell as object

'mit folgendem wird der "Aufpasser" auf Tabelle1.B1:B12 angesetzt:
Sub addlistener
      ocell=thiscomponent.sheets().GetByName("Tabelle1").getcellrangebyname("B1:B12")
      oListener = CreateUnoListener( "AutomergDoc_", "com.sun.star.util.XModifyListener" )
      ocell.addmodifylistener(olistener)
End Sub

'Damit wird er entfernt
Sub Remove_Listener
On Error Resume Next
ocell.removemodifyListener(oListener)
End Sub

'Hier wird im Falle einer Änderung 'merge_gleiche_Werte' gestartet
Sub AutomergDoc_Modified(oEvent)
merge_gleiche_Werte
End Sub

Hallo
Zunächst brauchst du in Spalte A eine Formel die 1 oder 2 einträgt abhängig von dem Wert der Nachbarzelle:
=WENN(B1>=40;1;2)
dann benötigst du ein Makro das alle gleichen Werte in A zu jeweils einer Zelle zusammenfasst.
[code]sub merge_gleiche_Werte
odoc = ThisComponent
osheet = odoc.sheets(0) '1. Tabellenblatt

do while osheet.getcellbyposition(0,i).value > 0
startz = i
x = osheet.getcellbyposition(0,i).value
i = i +1
do while osheet.getcellbyposition(0,i).value = x
i = i +1
loop
'evtl. vorhandene Zusammenfassungen im Bereich aufheben
osheet.getcellrangebyposition(0,startz,0,i -1).merge(false)
'und den ganzen Bereich zusammenfassen
osheet.getcellrangebyposition(0,startz,0,i-1).merge(true)
loop
end sub
[/code]
um das ganze automatisch bei jeder Änderung in Spalte B ablaufen zu lassen, müsstest du einen Eventlisterer starten:

[code]Global oListener As Object
Global ocell as object

'mit folgendem wird der "Aufpasser" auf Tabelle1.B1:B12 angesetzt:
Sub addlistener
ocell=thiscomponent.sheets().GetByName("Tabelle1").getcellrangebyname("B1:B12")
oListener = CreateUnoListener( "AutomergDoc_", "com.sun.star.util.XModifyListener" )
ocell.addmodifylistener(olistener)
End Sub

'Damit wird er entfernt
Sub Remove_Listener
On Error Resume Next
ocell.removemodifyListener(oListener)
End Sub

'Hier wird im Falle einer Änderung 'merge_gleiche_Werte' gestartet
Sub AutomergDoc_Modified(oEvent)
merge_gleiche_Werte
End Sub[/code]

Gruß Karo

Hallo nOOby,

geht es DIr wirklich um eine Veränderung der Zelle in Spalte A? Also muß sich wirklich aus irgend einem Grund die Zellgröße verändern? Oder reicht es, wenn es nur so aussieht?

Ich hab mal eine Hilfsspalte angelegt, in der die Zugehörigkeit zu den einzelnen Bereichen drinsteht. Auf die greift in Spalte C ein SVerweis zu. Dann hab ich Formatvorlagen angelegt und laß die mit VORLAGE mir in den jeweiligen Zellen anzeigen. Ich hab mal 2 Versionen gemacht, einmal mit Farbe und einmal nur mit einem Strich.

Was leider noch nicht klappt, ist, daß dann in einer Zelle, so wie in Deinem Beispiel, eine 1 oder 2 drin steht.

Aber vielleicht kannst Du ja auf meinem Beispiel aufbauend was passendes ausdenken

Viele Grüße
AhQ