Sortierpriorität ädern bei bubble sort???

LSH_Dackel · Beitrag von **LSH_Dackel** » Fr, 08.09.2006 15:37

Moin ich hab leider schon wieder ein Problem

Bei meinem makro sollen werden werte nach größe sortiert werden.
das funzt auch wenn die werte zahlen sind , aber wenn es sich um Text handelt
wird dieser immer höher sortiert als die zahlen.

http://lshdackel.ls.funpic.de/Demo/Problem.jpg

Code: Alles auswählen

sub ranking22HJTemp2_BP

Dim Entry(1, 31)
Dim Count As Double
Dim Count2 As Double


oSheets = ThisComponent.Sheets 
oSheet = oSheets.getByName("HJLübersicht")

Entry(0,1) = oSheet.getCellByposition(38,6).formula
Entry(0,2) = oSheet.getCellByposition(38,7).formula
Entry(0,3) = oSheet.getCellByposition(38,8).formula
Entry(0,4) = oSheet.getCellByposition(38,9).formula
Entry(0,5) = oSheet.getCellByposition(38,10).formula
Entry(0,6) = oSheet.getCellByposition(38,11).formula
Entry(0,7) = oSheet.getCellByposition(38,12).formula
Entry(0,8) = oSheet.getCellByposition(38,13).formula
Entry(0,9) = oSheet.getCellByposition(38,14).formula
Entry(0,10) = oSheet.getCellByposition(38,15).formula
Entry(0,11) = oSheet.getCellByposition(38,16).formula
Entry(0,12) = oSheet.getCellByposition(38,17).formula
Entry(0,13) = oSheet.getCellByposition(38,18).formula
Entry(0,14) = oSheet.getCellByposition(38,19).formula
Entry(0,15) = oSheet.getCellByposition(38,20).formula
Entry(0,16) = oSheet.getCellByposition(38,21).formula
Entry(0,17) = oSheet.getCellByposition(38,22).formula
Entry(0,18) = oSheet.getCellByposition(38,23).formula
Entry(0,19) = oSheet.getCellByposition(38,24).formula
Entry(0,20) = oSheet.getCellByposition(38,25).formula
Entry(0,21) = oSheet.getCellByposition(38,26).formula
Entry(0,22) = oSheet.getCellByposition(38,27).formula
Entry(0,23) = oSheet.getCellByposition(38,28).formula
Entry(0,24) = oSheet.getCellByposition(38,29).formula
Entry(0,25) = oSheet.getCellByposition(38,30).formula
Entry(0,26) = oSheet.getCellByposition(38,31).formula
Entry(0,27) = oSheet.getCellByposition(38,32).formula
Entry(0,28) = oSheet.getCellByposition(38,33).formula
Entry(0,29) = oSheet.getCellByposition(38,34).formula
Entry(0,30) = oSheet.getCellByposition(38,35).formula
Entry(0,31) = oSheet.getCellByposition(38,36).formula

Entry(1,1) = oSheet.getCellByposition(37,6).formula
Entry(1,2) = oSheet.getCellByposition(37,7).formula
Entry(1,3) = oSheet.getCellByposition(37,8).formula
Entry(1,4) = oSheet.getCellByposition(37,9).formula
Entry(1,5) = oSheet.getCellByposition(37,10).formula
Entry(1,6) = oSheet.getCellByposition(37,11).formula
Entry(1,7) = oSheet.getCellByposition(37,12).formula
Entry(1,8) = oSheet.getCellByposition(37,13).formula
Entry(1,9) = oSheet.getCellByposition(37,14).formula
Entry(1,10) = oSheet.getCellByposition(37,15).formula
Entry(1,11) = oSheet.getCellByposition(37,16).formula
Entry(1,12) = oSheet.getCellByposition(37,17).formula
Entry(1,13) = oSheet.getCellByposition(37,18).formula
Entry(1,14) = oSheet.getCellByposition(37,19).formula
Entry(1,15) = oSheet.getCellByposition(37,20).formula
Entry(1,16) = oSheet.getCellByposition(37,21).formula
Entry(1,17) = oSheet.getCellByposition(37,22).formula
Entry(1,18) = oSheet.getCellByposition(37,23).formula
Entry(1,19) = oSheet.getCellByposition(37,24).formula
Entry(1,20) = oSheet.getCellByposition(37,25).formula
Entry(1,21) = oSheet.getCellByposition(37,26).formula
Entry(1,22) = oSheet.getCellByposition(37,27).formula
Entry(1,23) = oSheet.getCellByposition(37,28).formula
Entry(1,24) = oSheet.getCellByposition(37,29).formula
Entry(1,25) = oSheet.getCellByposition(37,30).formula
Entry(1,26) = oSheet.getCellByposition(37,31).formula
Entry(1,27) = oSheet.getCellByposition(37,32).formula
Entry(1,28) = oSheet.getCellByposition(37,33).formula
Entry(1,29) = oSheet.getCellByposition(37,34).formula
Entry(1,30) = oSheet.getCellByposition(37,35).formula
Entry(1,31) = oSheet.getCellByposition(37,36).formula

For Count = 1 To 31
For Count2 = Count + 1 To 31
If Entry(0,Count) < Entry(0,Count2) Then
Temp = Entry(0,Count)
Temp2 = Entry(1,Count)
Entry(0,Count) = Entry(0,Count2)
Entry(1,Count) = Entry(1,Count2)
Entry(0,Count2) = Temp
Entry(1,Count2) = Temp2
End If

Next Count2
Next Count

   For Count = 1 To 31
     oSheet.getCellByposition(48, 5 + Count).setformula(Entry (0,Count))
     oSheet.getCellByposition(47, 5 + Count).setformula(Entry (1,Count))
   next  count

end sub

Also möchte ich gern wissen wie ich es anstelle das der höchste zahlen wert oben steht und der text erst unter allen zahlen.

THX im vorraus
MFG LSH_Dackel

Stephan · Beitrag von **Stephan** » Fr, 08.09.2006 18:12

Ich würde Zahlen und Strings getrennt einlesen und sortieren, beispielsweise:

Code: Alles auswählen

Sub Main
Dim Entry_s(1, 1)
Dim Entry_v(1, 1)
Dim Entry(1, 31)

oSheets = ThisComponent.Sheets 
oSheet = oSheets.getByName("HJLübersicht")
j = 1
k = 1
For i = 1 To 31
	Cell = oSheet.getCellByposition(38,5+i)
	Select Case Cell.Type
		Case com.sun.star.table.CellContentType.VALUE
			Entry_v(0,j) = oSheet.getCellByposition(38,5+i).Value
			Entry_v(1,j) = oSheet.getCellByposition(37,5+i).formula
			j = j + 1
			Redim Preserve Entry_v(1,j) 
		Case Else
			Entry_s(0,k) = oSheet.getCellByposition(38,5+i).String
			Entry_s(1,k) = oSheet.getCellByposition(37,5+i).formula
			k = k + 1
			Redim Preserve Entry_s(1,k) 
	End Select
Next i

Redim Preserve Entry_v(1,j-1)
Redim Preserve Entry_s(1,k-1) 

'*
For Count = 1 To UBOUND(Entry_v(),2)
	For Count2 = Count + 1 To UBOUND(Entry_v(),2)
		If Entry_v(0,Count) < Entry_v(0,Count2) Then 
			Temp = Entry_v(0,Count) 
			Temp2 = Entry_v(1,Count) 
			Entry_v(0,Count) = Entry_v(0,Count2) 
			Entry_v(1,Count) = Entry_v(1,Count2) 
			Entry_v(0,Count2) = Temp 
			Entry_v(1,Count2) = Temp2 
		End If 
	Next Count2 
Next Count

'**
For Count = 1 To UBOUND(Entry_s(),2)
	For Count2 = Count + 1 To UBOUND(Entry_s(),2)
		If Entry_s(0,Count) < Entry_s(0,Count2) Then 
			Temp = Entry_s(0,Count) 
			Temp2 = Entry_s(1,Count) 
			Entry_s(0,Count) = Entry_s(0,Count2) 
			Entry_s(1,Count) = Entry_s(1,Count2) 
			Entry_s(0,Count2) = Temp 
			Entry_s(1,Count2) = Temp2 
		End If 
	Next Count2 
Next Count

For Count = 1 To UBOUND(Entry_v(),2)
	Entry(0, Count) = Entry_v(0, Count)
	Entry(1, Count) = Entry_v(1, Count)
next count

i = Count

For Count = i To 31
	Entry(0, Count) = Entry_s(0, Count-UBOUND(Entry_s(),2)+1)
	Entry(1, Count) = Entry_s(1, Count-UBOUND(Entry_s(),2)+1)
next count

For Count = 1 To 31 
     oSheet.getCellByposition(48, 5 + Count).setformula(Entry (0,Count)) 
     oSheet.getCellByposition(47, 5 + Count).setformula(Entry (1,Count)) 
next count

End Sub

Gruß
Stephan

LSH_Dackel · Beitrag von **LSH_Dackel** » Fr, 08.09.2006 19:16

Hallo stephan ich hab deinen code ausprobiert
aber immer wenn ich ihn ausführe stürtz mein openoffice ab

aber schaus dir doch einfach mal selber an.

http://lshdackel.ls.funpic.de/Demo/Fehl ... gstufe.ods

Stephan · Beitrag von **Stephan** » Fr, 08.09.2006 19:53

aber immer wenn ich ihn ausführe stürtz mein openoffice ab

Ich hoffe das ist jetzt nicht wörtlich zu nehmen.
Also wenn das Makro nur nur unterbricht und in der Basic-IDE eine Zeile markiert ist (so wirkte sich der Fehler bei mir aus) nennt sich das in etwa "Makro stoppt ohne Fehlermeldung" - ein Absturz ist ein wenig anders.

Das Folgende sollte (hoffentlich) gehen:

Code: Alles auswählen

sub ranking22HJTemp2_BP

Dim Entry_s(1, 1)
Dim Entry_v(1, 1)
Dim Entry(1, 31)

oSheets = ThisComponent.Sheets
oSheet = oSheets.getByName("HJLübersicht")
j = 1
k = 1
For i = 1 To 31
   Cell = oSheet.getCellByposition(38,5+i)
   Select Case Cell.Type
      Case com.sun.star.table.CellContentType.VALUE
         Entry_v(0,j) = oSheet.getCellByposition(38,5+i).Value
         Entry_v(1,j) = oSheet.getCellByposition(37,5+i).formula
         j = j + 1
         Redim Preserve Entry_v(1,j)
      Case Else
         Entry_s(0,k) = oSheet.getCellByposition(38,5+i).String
         Entry_s(1,k) = oSheet.getCellByposition(37,5+i).formula
         k = k + 1
         Redim Preserve Entry_s(1,k)
   End Select
Next i

Redim Preserve Entry_v(1,j-1)
Redim Preserve Entry_s(1,k-1)

'*
For Count = 1 To UBOUND(Entry_v(),2)
   For Count2 = Count + 1 To UBOUND(Entry_v(),2)
      If Entry_v(0,Count) < Entry_v(0,Count2) Then
         Temp = Entry_v(0,Count)
         Temp2 = Entry_v(1,Count)
         Entry_v(0,Count) = Entry_v(0,Count2)
         Entry_v(1,Count) = Entry_v(1,Count2)
         Entry_v(0,Count2) = Temp
         Entry_v(1,Count2) = Temp2
      End If
   Next Count2
Next Count

'**
For Count = 1 To UBOUND(Entry_s(),2)
   For Count2 = Count + 1 To UBOUND(Entry_s(),2)
      If Entry_s(0,Count) < Entry_s(0,Count2) Then
         Temp = Entry_s(0,Count)
         Temp2 = Entry_s(1,Count)
         Entry_s(0,Count) = Entry_s(0,Count2)
         Entry_s(1,Count) = Entry_s(1,Count2)
         Entry_s(0,Count2) = Temp
         Entry_s(1,Count2) = Temp2
      End If
   Next Count2
Next Count

For Count = 1 To UBOUND(Entry_v(),2)
   Entry(0, Count) = Entry_v(0, Count)
   Entry(1, Count) = Entry_v(1, Count)
next count

i = Count

For Count = i To 31
   Entry(0, Count) = Entry_s(0, Count-i+1)
   Entry(1, Count) = Entry_s(1, Count-i+1)
next count

For Count = 1 To 31
     oSheet.getCellByposition(48, 5 + Count).setformula(Entry (0,Count))
     oSheet.getCellByposition(47, 5 + Count).setformula(Entry (1,Count))
next count

End Sub

Gruß
Stephan

LSH_Dackel · Beitrag von **LSH_Dackel** » So, 10.09.2006 15:52

Nein du kannst das ruhig wörtlich nehmen.

Mein komplettes openoffice schmiert mir ab wenn ich dieses makro bzw. eins in der selben lib ausführe.

Da ich dachte das es an meinem PC liegt habe ich mein wondows innerhalb
der letzten 2 Tage 3 mal neu installiert . Was allerdings nichts geholfen hat das der fehler noch immer auftrit.

die datei findest du hier

http://lshdackel.ls.funpic.de/Demo/Fehl ... gstufe.ods

bitte versuch es auch ein mal und bestätige mir mein problem

und wenn du was mit fehlerberichte anfangen kannst dann schau dir den von mir mal an und sag mir woran es liegt

http://lshdackel.ls.funpic.de/Demo/Fehl ... ericht.txt

schon ma THX im Vorraus

MFG LSH_Dackel

Stephan · Beitrag von **Stephan** » So, 10.09.2006 18:02

Nein du kannst das ruhig wörtlich nehmen.

Mein komplettes openoffice schmiert mir ab wenn ich dieses makro bzw. eins in der selben lib ausführe.

OK, hatte ich jetzt nicht vermutet, aber ist dann so.
Einzig macht das weitere Bemühungen schwierig, denn wenn das Makro OOo abstürzen lässt weiß ich nicht warum und kann Dir da praktisch nicht weiterhelfen.
Ich verwende hier OOo 2.0.2 deutsch auf Windows 2000 und da stoppt das ursprüngliche Makro mit einer Fehlermeldung. Das korrigierte Makro was ich gepostet habe funktioniert hier einwandfrei.

bitte versuch es auch ein mal und bestätige mir mein problem

habe ich getan, aber OOo stürzt nicht ab. Lediglich das Makro stoppt und die entsprechende Zeille ist markiert.

Einzig, würde ich Dich bitten die korrigierte Version des Makros in Deine Datei aufzunehmen, denn obwohl ich wie gesagt nicht weiß woher der Absturz kommt, wird das Makro (weil Du die alte fehlerhafte Version benutzt) Absturz hin oder her ohnehin nicht richtig funktionieren.

und wenn du was mit fehlerberichte anfangen kannst dann schau dir den von mir mal an und sag mir woran es liegt

Nein, tut mir leid so gut bin ich nicht.
Ich würde Dir aber raten OOo zu gestatten den Fehlerbericht zu versenden (falls Du es nicht schon getan hast), denn es muß ja ein Problem vorliegen was OOo abstürzen lässt und ohne Fehlerbericht gelangt das den Entwicklern nicht zur Kenntnis.
Du kannst ganz ohne Sorge sein, einzig erhälst Du eine Bestätigungsmail und evtl. (Wochen bis Monate später) noch eine Dankesmail mit dem Hinweis das der Fehler beseitigt wurde und was der Fehler war. Die Leute die die Fehlermeldungen lesen sind im Konkreten die Entwickler von SUN in Hamburg.

Wenn Du magst kannst Du Dir auch ein paar der Entwickler ansehen:
*gib in Calc folgende Zellformel ein:
=StarCalcTeam()
und Du siehst ein Bild von 5 der Calc-Entwickler

*gib in Writer den Text:
StarWriterTeam
ein und drücke F3 und Du siehst ein Bild der Writer-Entwickler

Gruß
Stephan

LSH_Dackel · Beitrag von **LSH_Dackel** » So, 10.09.2006 18:48

Ich habe es auch schon mit der verbesserten version probier aber da die auch zum absturz geführt hat habe ich das dokument verworfen.

Aber trotzen danke für deine bemühungen.

MFG LSH_Dackel

Stephan · Beitrag von **Stephan** » So, 10.09.2006 20:37

Ich habe es auch schon mit der verbesserten version probier aber da die auch zum absturz geführt hat habe ich das dokument verworfen.

und nun?

Also eigentlich solltest Du jetzt das Makro debuggen, was angesichst der Tatsache das OOo abstürzt dadurch möglich wäre das Du an günstigen Stellen des Makros Message-Boxen plazierst und beobachtest welche diese Messageboxen als letzte angezeigt wird bevor OOo abstürtzt. So hätten wir zumindest einen Hinweis wo wir den Fehler suchen müßten, obwohl ich bezüglich des Absturzes nicht mal eine Vermutung hätte wenn wir wüßten wo etwas fehlerhaft ist, was dann fehlerhaft ist, denn der Code ist gut zu überblicken.

Da wir nun zunächst garnicht wissen wie der Absturz zustande kommt wäre es wohl am Einfachsten einen Code zu verwenden der gegenüber dem von Dir als funktionierend benannten Ausgangscode möglichst wenig verändert ist. Deshalb probiere mal ob ein einfaches Umsortieren der schon fertig eingetragenen Werte keinen Absturz erzeugt:

Code: Alles auswählen

sub ranking22HJTemp2_BP 

Dim Entry(1, 31) 
Dim Count As Double 
Dim Count2 As Double 


oSheets = ThisComponent.Sheets 
oSheet = oSheets.getByName("HJLübersicht") 

Entry(0,1) = oSheet.getCellByposition(38,6).formula 
Entry(0,2) = oSheet.getCellByposition(38,7).formula 
Entry(0,3) = oSheet.getCellByposition(38,8).formula 
Entry(0,4) = oSheet.getCellByposition(38,9).formula 
Entry(0,5) = oSheet.getCellByposition(38,10).formula 
Entry(0,6) = oSheet.getCellByposition(38,11).formula 
Entry(0,7) = oSheet.getCellByposition(38,12).formula 
Entry(0,8) = oSheet.getCellByposition(38,13).formula 
Entry(0,9) = oSheet.getCellByposition(38,14).formula 
Entry(0,10) = oSheet.getCellByposition(38,15).formula 
Entry(0,11) = oSheet.getCellByposition(38,16).formula 
Entry(0,12) = oSheet.getCellByposition(38,17).formula 
Entry(0,13) = oSheet.getCellByposition(38,18).formula 
Entry(0,14) = oSheet.getCellByposition(38,19).formula 
Entry(0,15) = oSheet.getCellByposition(38,20).formula 
Entry(0,16) = oSheet.getCellByposition(38,21).formula 
Entry(0,17) = oSheet.getCellByposition(38,22).formula 
Entry(0,18) = oSheet.getCellByposition(38,23).formula 
Entry(0,19) = oSheet.getCellByposition(38,24).formula 
Entry(0,20) = oSheet.getCellByposition(38,25).formula 
Entry(0,21) = oSheet.getCellByposition(38,26).formula 
Entry(0,22) = oSheet.getCellByposition(38,27).formula 
Entry(0,23) = oSheet.getCellByposition(38,28).formula 
Entry(0,24) = oSheet.getCellByposition(38,29).formula 
Entry(0,25) = oSheet.getCellByposition(38,30).formula 
Entry(0,26) = oSheet.getCellByposition(38,31).formula 
Entry(0,27) = oSheet.getCellByposition(38,32).formula 
Entry(0,28) = oSheet.getCellByposition(38,33).formula 
Entry(0,29) = oSheet.getCellByposition(38,34).formula 
Entry(0,30) = oSheet.getCellByposition(38,35).formula 
Entry(0,31) = oSheet.getCellByposition(38,36).formula 

Entry(1,1) = oSheet.getCellByposition(37,6).formula 
Entry(1,2) = oSheet.getCellByposition(37,7).formula 
Entry(1,3) = oSheet.getCellByposition(37,8).formula 
Entry(1,4) = oSheet.getCellByposition(37,9).formula 
Entry(1,5) = oSheet.getCellByposition(37,10).formula 
Entry(1,6) = oSheet.getCellByposition(37,11).formula 
Entry(1,7) = oSheet.getCellByposition(37,12).formula 
Entry(1,8) = oSheet.getCellByposition(37,13).formula 
Entry(1,9) = oSheet.getCellByposition(37,14).formula 
Entry(1,10) = oSheet.getCellByposition(37,15).formula 
Entry(1,11) = oSheet.getCellByposition(37,16).formula 
Entry(1,12) = oSheet.getCellByposition(37,17).formula 
Entry(1,13) = oSheet.getCellByposition(37,18).formula 
Entry(1,14) = oSheet.getCellByposition(37,19).formula 
Entry(1,15) = oSheet.getCellByposition(37,20).formula 
Entry(1,16) = oSheet.getCellByposition(37,21).formula 
Entry(1,17) = oSheet.getCellByposition(37,22).formula 
Entry(1,18) = oSheet.getCellByposition(37,23).formula 
Entry(1,19) = oSheet.getCellByposition(37,24).formula 
Entry(1,20) = oSheet.getCellByposition(37,25).formula 
Entry(1,21) = oSheet.getCellByposition(37,26).formula 
Entry(1,22) = oSheet.getCellByposition(37,27).formula 
Entry(1,23) = oSheet.getCellByposition(37,28).formula 
Entry(1,24) = oSheet.getCellByposition(37,29).formula 
Entry(1,25) = oSheet.getCellByposition(37,30).formula 
Entry(1,26) = oSheet.getCellByposition(37,31).formula 
Entry(1,27) = oSheet.getCellByposition(37,32).formula 
Entry(1,28) = oSheet.getCellByposition(37,33).formula 
Entry(1,29) = oSheet.getCellByposition(37,34).formula 
Entry(1,30) = oSheet.getCellByposition(37,35).formula 
Entry(1,31) = oSheet.getCellByposition(37,36).formula 

For Count = 1 To 31 
For Count2 = Count + 1 To 31 
If Entry(0,Count) < Entry(0,Count2) Then 
Temp = Entry(0,Count) 
Temp2 = Entry(1,Count) 
Entry(0,Count) = Entry(0,Count2) 
Entry(1,Count) = Entry(1,Count2) 
Entry(0,Count2) = Temp 
Entry(1,Count2) = Temp2 
End If 

Next Count2 
Next Count 

   For Count = 1 To 31 
     oSheet.getCellByposition(48, 5 + Count).setformula(Entry (0,Count)) 
     oSheet.getCellByposition(47, 5 + Count).setformula(Entry (1,Count)) 
   next  count 

'Ergänzung
For i = 6 To 36
	akt = oSheet.getCellByposition(48, i)
	if akt.type = com.sun.star.table.CellContentType.VALUE Then
		start = i
		exit For
	End if
Next i
Dim a(1, 30)
j = 0
For i = start to 36
	if oSheet.getCellByposition(47, i).formula = "" Then
		exit for
	end if
	a(0, j) = oSheet.getCellByposition(47, i).formula
	a(1, j) = oSheet.getCellByposition(48, i).formula
	j = j + 1
Next i
for i = 6 To start - 1
	a(0, j) = oSheet.getCellByposition(47, i).formula
	a(1, j) = oSheet.getCellByposition(48, i).formula
	j = j +1
Next 
For i = 0 To UBOUND(a(),2)
	oSheet.getCellByposition(47, i+6).formula = a(0,i)
	oSheet.getCellByposition(48, i+6).formula = a(1,i)
Next i

end sub

Falls das bei Dir wieder zu einem Absturz führt (bei mir läuft es) müssen wir dann als Nächstes wirklich den, den Code debuggen indem wir zunächst die Fehlerstelle lokalisieren.

Gruß
Stephan

LSH_Dackel · Beitrag von **LSH_Dackel** » Sa, 16.09.2006 13:46

Hallo stephan dein makro fuzt doch , mein rechner hat rumgesponnen

Kannst du mir des makro auch umformen und vieleicht noch ein bisschen
auskommentieren denn ich blick da net so ganz durch wie du des gemacht hast

Code: Alles auswählen

sub rankingABIGK
Dim oSheets as Object 
Dim oSheet as Object 
Dim zelle as Object 
Dim Entry(1, 3)
Dim Count As Double
Dim Count2 As Double
Dim Temp As Double

oSheets = ThisComponent.Sheets 
oSheet = oSheets.getByName("HJLübersicht")
For zeile = 3 to 4
Entry(0,1) = oSheet.getCellByposition(1,zeile).string 'aus spalte 12_1 
Entry(0,2) = oSheet.getCellByposition(2,zeile).string 'aus spalte 12_2
Entry(0,3) = oSheet.getCellByposition(3,zeile).string 'aus spalte 13_1
Entry(1,1) = "12_1"
Entry(1,2) = "12_2"
Entry(1,3) = "13_1"
For Count = 1 To 3
For Count2 = Count + 1 To 3
If Entry(0,Count) < Entry(0,Count2) Then
Temp = Entry(0,Count)
Temp2 = Entry(1,Count)
Entry(0,Count) = Entry(0,Count2)
Entry(1,Count) = Entry(1,Count2)
Entry(0,Count2) = Temp
Entry(1,Count2) = Temp2
End If
Next Count2
Next Count

   For Count = 1 To 3
     oSheet.getCellByposition(25 +count, zeile).setformula((Entry (0,Count))
     oSheet.getCellByposition(29 +count, zeile).setformula((Entry (1,Count))
   Next
next zeile

end sub

schon ma thx

MFG LSH_Dackel

Stephan · Beitrag von **Stephan** » So, 17.09.2006 10:30

Kannst du mir des makro auch umformen und vieleicht noch ein bisschen
auskommentieren denn ich blick da net so ganz durch wie du des gemacht hast

Naja, ich weiß nun nicht so recht was Du meinst (ich bin nichtmal sicher ob der Code von mir ist) und sehe zunächst höchstens das das Sortieren anders sein sollte:

Code: Alles auswählen

'...
'die Schleife um alle Felder zu durchlaufen
For Count = 1 To 3 
'die Schleife um alle Felder mit Höherem 'Index' als das aktuelle zu durchlaufen
For Count2 = Count + 1 To 3 
'das Sortierkriterium vergleichen
If Entry(0,Count) < Entry(0,Count2) Then 
'die vorhandenen Werte sichern um sie im Array selbst überschreiben zu können
Temp = Entry(0,Count) 
Temp2 = Entry(1,Count) 
Temp3 = Entry(2,Count) 
'die Werte im Array überschreiben und die gesicherten Werte eintragen - insgesamt also letztlich nur eine Vertauschung zweier Array-Zeilen
Entry(0,Count) = Entry(0,Count2) 
Entry(1,Count) = Entry(1,Count2) 
Entry(2,Count) = Entry(2,Count2)
Entry(0,Count2) = Temp 
Entry(1,Count2) = Temp2 
Entry(2,Count2) = Temp3 
End If 
Next Count2 
Next Count 
'...

Gruß
Stephan

LSH_Dackel · Beitrag von **LSH_Dackel** » So, 17.09.2006 11:32

Hallo Stephan

Wir anscheinend wieder mal unsere altbekannten Kommunikationsprobleme

der code war vonmir und ich hätte gern das du ihn so umformst das die zahlen oben stehn
und erst dann die strings kommen.
so wiedu das schon oben gemacht hast.

schon ma THX

MFG LSH_Dackel

Stephan · Beitrag von **Stephan** » So, 17.09.2006 15:03

der code war vonmir und ich hätte gern das du ihn so umformst das die zahlen oben stehn
und erst dann die strings kommen.

da sind keinerlei Zahlen, die zu berücksichtigen wären. Du liest mit:

Code: Alles auswählen

Entry(0,1) = oSheet.getCellByposition(1,zeile).string 'aus spalte 12_1 
Entry(0,2) = oSheet.getCellByposition(2,zeile).string 'aus spalte 12_2 
Entry(0,3) = oSheet.getCellByposition(3,zeile).string 'aus spalte 13_1

und da das alles Strings sind werden bei der Sortierung doch keine Zahlen berücksichtigt, weil garnicht vorhanden.

Gruß
Stephan

LSH_Dackel · Beitrag von **LSH_Dackel** » So, 17.09.2006 15:48

Ok ich glaub wir ham unser problem mit de kommunikation noch immer net gelöst

Also wie muss ich dieses makro umschreiben

Code: Alles auswählen

sub ranking22HJTemp2_BP

Dim Entry_s(1, 1)
Dim Entry_v(1, 1)
Dim Entry(1, 31)

oSheets = ThisComponent.Sheets
oSheet = oSheets.getByName("HJLübersicht")
j = 1
k = 1
For i = 1 To 31
   Cell = oSheet.getCellByposition(38,5+i)
   Select Case Cell.Type
      Case com.sun.star.table.CellContentType.VALUE
         Entry_v(0,j) = oSheet.getCellByposition(38,5+i).Value
         Entry_v(1,j) = oSheet.getCellByposition(37,5+i).formula
         j = j + 1
         Redim Preserve Entry_v(1,j)
      Case Else
         Entry_s(0,k) = oSheet.getCellByposition(38,5+i).String
         Entry_s(1,k) = oSheet.getCellByposition(37,5+i).formula
         k = k + 1
         Redim Preserve Entry_s(1,k)
   End Select
Next i

Redim Preserve Entry_v(1,j-1)
Redim Preserve Entry_s(1,k-1)

'*
For Count = 1 To UBOUND(Entry_v(),2)
   For Count2 = Count + 1 To UBOUND(Entry_v(),2)
      If Entry_v(0,Count) < Entry_v(0,Count2) Then
         Temp = Entry_v(0,Count)
         Temp2 = Entry_v(1,Count)
         Entry_v(0,Count) = Entry_v(0,Count2)
         Entry_v(1,Count) = Entry_v(1,Count2)
         Entry_v(0,Count2) = Temp
         Entry_v(1,Count2) = Temp2
      End If
   Next Count2
Next Count

'**
For Count = 1 To UBOUND(Entry_s(),2)
   For Count2 = Count + 1 To UBOUND(Entry_s(),2)
      If Entry_s(0,Count) < Entry_s(0,Count2) Then
         Temp = Entry_s(0,Count)
         Temp2 = Entry_s(1,Count)
         Entry_s(0,Count) = Entry_s(0,Count2)
         Entry_s(1,Count) = Entry_s(1,Count2)
         Entry_s(0,Count2) = Temp
         Entry_s(1,Count2) = Temp2
      End If
   Next Count2
Next Count

For Count = 1 To UBOUND(Entry_v(),2)
   Entry(0, Count) = Entry_v(0, Count)
   Entry(1, Count) = Entry_v(1, Count)
next count

i = Count

For Count = i To 31
   Entry(0, Count) = Entry_s(0, Count-i+1)
   Entry(1, Count) = Entry_s(1, Count-i+1)
next count

For Count = 1 To 31
     oSheet.getCellByposition(48, 5 + Count).setformula(Entry (0,Count))
     oSheet.getCellByposition(47, 5 + Count).setformula(Entry (1,Count))
next count

End Sub

damit es die werte aus den selben zellen wie dieses makro

Code: Alles auswählen

sub rankingABIGK
Dim oSheets as Object
Dim oSheet as Object
Dim zelle as Object
Dim Entry(1, 3)
Dim Count As Double
Dim Count2 As Double
Dim Temp As Double

oSheets = ThisComponent.Sheets
oSheet = oSheets.getByName("HJLübersicht")
For zeile = 3 to 4
Entry(0,1) = oSheet.getCellByposition(1,zeile).string 'aus spalte 12_1
Entry(0,2) = oSheet.getCellByposition(2,zeile).string 'aus spalte 12_2
Entry(0,3) = oSheet.getCellByposition(3,zeile).string 'aus spalte 13_1
Entry(1,1) = "12_1"
Entry(1,2) = "12_2"
Entry(1,3) = "13_1"
For Count = 1 To 3
For Count2 = Count + 1 To 3
If Entry(0,Count) < Entry(0,Count2) Then
Temp = Entry(0,Count)
Temp2 = Entry(1,Count)
Entry(0,Count) = Entry(0,Count2)
Entry(1,Count) = Entry(1,Count2)
Entry(0,Count2) = Temp
Entry(1,Count2) = Temp2
End If
Next Count2
Next Count

   For Count = 1 To 3
     oSheet.getCellByposition(25 +count, zeile).setformula((Entry (0,Count))
     oSheet.getCellByposition(29 +count, zeile).setformula((Entry (1,Count))
   Next
next zeile

end sub

einliest und in die selben zellen schreibt (halt nur mit der anderen sortierpriorität)

Ich hoffe jetz hamm wirs

MFG LSH_Dackel

Stephan · Beitrag von **Stephan** » So, 17.09.2006 22:05

Ok ich glaub wir ham unser problem mit de kommunikation noch immer net gelöst

ich habe kein Kommunikationsproblem, nur ich kann nicht raten was Du willst und wenn Du einen Code postest der Texte einliest kann ich den nicht so umschreiben das er Zahlen sortiert.
Insofern ist das Folgende auch nur eine Vermutung, das Du wenn Du .String schreibst doch eigentlich .Formula meinst:

Code: Alles auswählen

sub rankingABIGK 
Dim oSheets as Object 
Dim oSheet as Object 
Dim zelle as Object 
Dim Entry(1, 3) 
Dim Count As Double 
Dim Count2 As Double 
Dim Temp As Double 

oSheets = ThisComponent.Sheets 
oSheet = oSheets.getByName("HJLübersicht") 
For zeile = 3 to 4 
Dim Entry_s(1, 1) 
Dim Entry_v(1, 1) 
j = 1 
k = 1
Cell = oSheet.getCellByposition(1,zeile) 
   Select Case Cell.Type 
      Case com.sun.star.table.CellContentType.VALUE 
         Entry_v(0,j) = oSheet.getCellByposition(1,zeile).Value 
         Entry_v(1,j) = 12_1" 
         j = j + 1 
         Redim Preserve Entry_v(1,j) 
      Case Else 
         Entry_s(0,k) = oSheet.getCellByposition(1,zeile).String 
         Entry_s(1,k) = 12_1"
         k = k + 1 
         Redim Preserve Entry_s(1,k) 
   End Select 

Cell = oSheet.getCellByposition(2,zeile) 
   Select Case Cell.Type 
      Case com.sun.star.table.CellContentType.VALUE 
         Entry_v(0,j) = oSheet.getCellByposition(2,zeile).Value 
         Entry_v(1,j) = 12_2" 
         j = j + 1 
         Redim Preserve Entry_v(1,j) 
      Case Else 
         Entry_s(0,k) = oSheet.getCellByposition(2,zeile).String 
         Entry_s(1,k) = 12_2"
         k = k + 1 
         Redim Preserve Entry_s(1,k) 
   End Select 

Cell = oSheet.getCellByposition(3,zeile) 
   Select Case Cell.Type 
      Case com.sun.star.table.CellContentType.VALUE 
         Entry_v(0,j) = oSheet.getCellByposition(3,zeile).Value 
         Entry_v(1,j) = 13_1" 
         j = j + 1 
         Redim Preserve Entry_v(1,j) 
      Case Else 
         Entry_s(0,k) = oSheet.getCellByposition(3,zeile).String 
         Entry_s(1,k) = 13_1"
         k = k + 1 
         Redim Preserve Entry_s(1,k) 
   End Select

Redim Preserve Entry_v(1,j-1) 
Redim Preserve Entry_s(1,k-1)

'* 
For Count = 1 To UBOUND(Entry_v(),2)
For Count2 = Count + 1 To UBOUND(Entry_v(),2) 
If Entry_v(0,Count) < Entry_v(0,Count2) Then 
Temp = Entry_v(0,Count) 
Temp2 = Entry_v(1,Count) 
Entry_v(0,Count) = Entry_v(0,Count2) 
Entry_v(1,Count) = Entry_v(1,Count2) 
Entry_v(0,Count2) = Temp 
Entry_v(1,Count2) = Temp2 
End If 
Next Count2 
Next Count 


'** 
For Count = 1 To UBOUND(Entry_s(),2)
For Count2 = Count + 1 To UBOUND(Entry_s(),2) 
If Entry_s(0,Count) < Entry_s(0,Count2) Then 
Temp = Entry_s(0,Count) 
Temp2 = Entry_s(1,Count) 
Entry_s(0,Count) = Entry_s(0,Count2) 
Entry_s(1,Count) = Entry_s(1,Count2) 
Entry_s(0,Count2) = Temp 
Entry_s(1,Count2) = Temp2 
End If 
Next Count2 
Next Count 

For Count = 1 To UBOUND(Entry_v(),2) 
   Entry(0, Count) = Entry_v(0, Count) 
   Entry(1, Count) = Entry_v(1, Count) 
next count 

i = Count

For Count = i To 3 
   Entry(0, Count) = Entry_s(0, Count-i+1) 
   Entry(1, Count) = Entry_s(1, Count-i+1) 
next count

For Count = 1 To 3 
     oSheet.getCellByposition(25 +count, zeile).setformula((Entry (0,Count)) 
     oSheet.getCellByposition(29 +count, zeile).setformula((Entry (1,Count)) 
   Next 
next zeile 

end sub

Gruß
Stephan

LSH_Dackel · Beitrag von **LSH_Dackel** » Mo, 18.09.2006 17:35

Hallo Stephan dein Makro funzt so weit aber das sortieren der zahlen werte haut net so hin.

http://lshdackel.ls.funpic.de/Demo/Screen3.gif

hier hast du auch noch mal die aktuelle version der tabelle

http://lshdackel.ls.funpic.de/Demo/Kolegstufe.ods

ich hoffe du kannst mir helfen

THX

MFG LSH_Dackel