Nichtleere Zellen aus 2 Spalten in eine Spalte zusammenfasse

[Fury1306]

Hallo!

Ich habe eine Tabelle die aus 2 Spalten besteht.

Ich möchte das aus dieser Tabelle die Zellen mit den Zeichenketten "ST", "MF", "AW", "TW", " " durch Leerzellen ersetzt werden. Es sollen nur die ersetzt werden die nichts anderes enthalten, also nicht geSTern usw.

Danach möchte ich das alle übriggebliebenen Zellen mit Inhalt untereinander in der 1. Spalte stehen.

Ich hab bereits versucht meine Aktionen als Makro aufzuzeichnen. Leider ist Openoffice jedesmal abgestürzt wenn ich das aufgezeichnete Makro ausführen ließ.

Eine Lösung als Makro wäre trotzdem am sinnvollsten, da ich diese Aktion mehrmals durchführen muss.

[Tim1202]

Hallo,

hier hab ich mal schnell was gecodet, ich hoff es entspricht deinen Erwartungen. Du musst evtl. noch ein paar Werte verändern. Momentan tut es im ersten Tabellenblatt die Spalten B+C "bereinigen" und dann die übrigen Werte in Spalte C zusammenfassen.
Here it comes:

Code: Alles auswählen

Sub SpaltenBereinigenUndZusammenfassen
	Dim SuchBeschreibung, oTabelle, oBereich As Object
	Dim gesucht(4), leer(4) As String
	Dim n, m, o, vSpalte1, vSpalte2, vSpalte3 as Integer
	Dim vLetzteZeile as Long
	vSpalte1 = 1	'Spalte B
	vSpalte2 = 2	'Spalte C
	vSpalte3 = 3	'Spalte D für die zusammengefassten Daten
	oTabelle = ThisComponent.Sheets(0)	'Das Tabellenblatt, dass benutzt werden soll
	'Festlegen in welcher Tabelle gesucht wird
	For m = vSpalte to vSpalte2
		oBereich = oTabelle.columns(m)
		SuchBeschreibung = oBereich.createReplaceDescriptor()
		SuchBeschreibung.SearchWords = true		'Sucht nach ganzen Zellen
		gesucht() = Array("ST", "MF", "AW", "TW")
		leer() = Array("", "", "", "")
		oReplace = oTabelle.createReplaceDescriptor()
		'oReplace.SearchCaseSensitive = True
		For n = LBound(gesucht()) To UBound(leer())
			oReplace.SearchString = gesucht(n)
			oReplace.ReplaceString = leer(n)
			oBereich.ReplaceAll(oReplace)
		Next n
	Next m
	'Jetzt müssen die Zellen zusammengeführt werden
	o=0	'Zeilenzähler für die 3.Spalte
	vLetzteZeile = GetLastUsedRow(oTabelle)
	For m = vSpalte1 to vSpalte2	'Schleife für die Spalten
		For n = 0 to vLetzteZeile	'Schleife für Zeilen
			If oTabelle.getCellByPosition(m, n).string = "" then
				'Leere Zelle
			else	'Belegte Zelle
				oTabelle.getCellByPosition(vSpalte3, o).string = oTabelle.getCellByPosition(m, n).string
				o=o+1
			end if
		Next n
	Next m
End Sub

'Diese Funktion ermittelt die letzte benützte Zeile
Function GetLastUsedRow(oSheet as Object) as Integer
Dim oCell As Object
Dim oCursor As Object
Dim aAddress As Variant
	oCell = oSheet.GetCellbyPosition(0, 0)
	oCursor = oSheet.createCursorByRange(oCell)
	oCursor.GotoEndOfUsedArea(True)
	aAddress = oCursor.RangeAddress
	GetLastUsedRow = aAddress.EndRow
End Function

Mfg

Timon

[Tim1202]

Hallo,

also ich hab ihn hier nochmal etwas überarbeitet:

Code: Alles auswählen

Sub Button_Click
	TestfuerForum(thiscomponent.currentcontroller.activeSheet)
End Sub

Sub TestfuerForum(oTabelle as Object)
	Dim SuchBeschreibung, oBereich As Object
	Dim vGesucht(4) as String	'Variable für Suchbegriffe   4 = Anzahl der Suchbegriffe
	Dim n, m, o, vSpalte1, vSpalte2, vSpalte3 as Integer
	Dim vLetzteZeile as Long
	vSpalte1 = 1	'Spalte B
	vSpalte2 = 2	'Spalte C
	vSpalte3 = 3	'Spalte D für die zusammengefassten Daten
	'Suchbegriffe festlegen:
	vGesucht() = array("ST", "MF", "AW", "TW")
	For n=0 to uBound(vGesucht())	'Alle Suchbegriffe extra durchlaufen
		For m = vSpalte to vSpalte2
			oBereich = oTabelle.columns(m)
			SuchBeschreibung = oBereich.createSearchDescriptor()
			SuchBeschreibung.SearchString = vGesucht(n)
			SuchBeschreibung.SearchWords = true		'Sucht nach ganzen Zellen
			oZelle =oBereich.FindFirst(SuchBeschreibung)
			Do While Not IsNull(oZelle)
				'vZelle = cellrangeAddressString(oZelle)
				oZelle.string = ""	'Zelleninhalt löschen
				oZelle = oBereich.findNext( oZelle, SuchBeschreibung)
			Loop
		Next m
	Next n
	'Jetzt müssen die Zellen zusammengeführt werden
	o=0	'Zeilenzähler für die 3.Spalte
	vLetzteZeile = GetLastUsedRow(oTabelle)
	For m = vSpalte1 to vSpalte2	'Schleife für die Spalten
		For n = 0 to vLetzteZeile	'Schleife für Zeilen
			If oTabelle.getCellByPosition(m, n).string = "" then
				'Leere Zelle
			else	'Belegte Zelle
				oTabelle.getCellByPosition(vSpalte3, o).string = oTabelle.getCellByPosition(m, n).string
				o=o+1
			end if
		Next n
	Next m
End Sub


Function GetLastUsedRow(oSheet as Object) as Integer
Dim oCell As Object
Dim oCursor As Object
Dim aAddress As Variant
	oCell = oSheet.GetCellbyPosition(0, 0)
	oCursor = oSheet.createCursorByRange(oCell)
	oCursor.GotoEndOfUsedArea(True)
	aAddress = oCursor.RangeAddress
	GetLastUsedRow = aAddress.EndRow
End Function

Bei mir hat er funktioniert. Ich verwende OOo 1.9er Beta. Evtl. könnte es noch sein, dass ich dein Problem falsch verstanden hätte.

Hier noch ein Link zu der Beispieldatei von mir: http://www.Faltraeder.com/Timon/testfuerforum.ods

Ach ja, die Cursorposition ist völlig Egal/Wurst/Ohne Belang/...

mfg

Timon

[Fury1306]

Bei der ersten Version hat bei mir das sortieren nicht funktioniert. Das Austauschen von AW, ST usw hat zu gut funktioniert. Es wurden auch die Zeichenfolgen mitten in einem Wort ersetzt.

Die 2. Version sortiert gut. Leider klappt es diesmal nicht mit dem Austauschen.

Ich hoffe ich halte dich nicht von wichtigeren Dingen ab.

Gruß

Karsten

[Tim1202]

Hallo,

könntest du das mit dem Austauschen genauer beschreiben? Ich weiß nicht was du damit meinst.
Ach ja, sortieren tu ich momentan noch nicht, nur zusammenfassen.

mfg

Timon

[Fury1306]

Hallo!

Ich hab mal eine Datei mit ein paar Beispielen hochgeladen.

Ich möchte das das ich alle Spieler untereinander oder neben einander stehen hab. Die Einträge sind durch Inhalte einfügen -- unformatierter Text entstanden.

http://mitglied.lycos.de/fury1972/Kader.sxc

[Tim1202]

Hallo Karsten,

sorry, dass es etwas gedauert hat, hatte n bisserl an stress .
Ich hab mir deine Datei angeschaut und es waren 3 Probleme:
1. im Makro müssen die richtigen Spalten eingestellt werden (ganz am Anfang die Zahlen)
2. standen bei dir in den Zellen nicht z.B. "TW" sondern "TW " - also mit Leerzeichen. Da aber nur nach ganzen Zellen gesucht wird findet das Programm diese Zellen nicht.
3. Es gab ein paar Zellen in denen nur ein Leerzeichen war. Dadurch sind sie nicht mehr Leer und werden als Spielername behandelt.

Ich hab das Makro erweitert sowie vereinfacht und in deine Kader-Datei integriert für dich bereitgestellt. Jetzt funzt es komplett.
http://www.Faltraeder.com/Timon/kader2.sxc

mfg

Timon

[Tim1202]

Ach ja,

falls es noch jemanden interessiert der neue vereinfachte und erweiterte Code ist jetzt:

Code: Alles auswählen

Sub Button_Click
	TestfuerForum(thiscomponent.currentcontroller.activeSheet)
End Sub

Sub TestfuerForum(oTabelle as Object)
	Dim oBereich As Object
	Dim n, m, o, vSpalte1, vSpalte2, vSpalte3 as Integer
	Dim vLetzteZeile as Long
	vSpalte1 = 0	'Spalte A
	vSpalte2 = 1	'Spalte B
	vSpalte3 = 3	'Spalte D für die zusammengefassten Daten
	'Jetzt müssen die Zellen zusammengeführt werden
	o=0	'Zeilenzähler für die 3.Spalte
	vLetzteZeile = GetLastUsedRow(oTabelle)
	For m = vSpalte1 to vSpalte2	'Schleife für die Spalten
		For n = 0 to vLetzteZeile	'Schleife für Zeilen
			select Case oTabelle.getCellByPosition(m, n).string
				case "ST", "ST ", "MF", "MF ", "AW", "AW ", "TW", "TW "
					'hier könnte man die Kürzel löschen:
					'oTabelle.getCellByPosition(m, n).string = ""				
				case "", " "		'Leere Zelle
					'nichts tun
				case else			'Spielernamen
					oTabelle.getCellByPosition(vSpalte3, o).string = oTabelle.getCellByPosition(m, n).string
					o=o+1			
			end select
		Next n
	Next m
End Sub


Function GetLastUsedRow(oSheet as Object) as Integer
Dim oCell As Object
Dim oCursor As Object
Dim aAddress As Variant
	oCell = oSheet.GetCellbyPosition(0, 0)
	oCursor = oSheet.createCursorByRange(oCell)
	oCursor.GotoEndOfUsedArea(True)
	aAddress = oCursor.RangeAddress
	GetLastUsedRow = aAddress.EndRow
End Function

mfg

Timon

[Fury1306]

Danke!

So klappt es.