ListBox.CompareRows: 1/1/2/3

Hallo,

ich stehe irgendwie mit der CompareRows Funktion auf dem Kriegsfu und bruchte bitte Hilfe bei der Sortierung von durch Schrger getrennte Zahlengruppen.

In der ListBox gibt es eine Spalte in der Kennzeichnungen wie z.B. 1/1/2/3 oder 0/1/2/12 stehen. Die ListBox soll anhand dieser Werte sortiert werden. Die Werte sind hierbei wie Gruppen zu betrachten.

Ein Beispiel:

1/1/3/12
0/1/3/12
1/2/1/0
2/0/0/1
0/1/2/1

sollten folgende Reihenfolge ergeben:

0/1/2/1
0/1/3/12
1/1/3/12
1/2/1/0
2/0/0/1

Einfacher gesagt, soll also erst nach dem ersten Wert vor dem “/” sortiert werden, dann sollen z.B. alle Zeilen die mit dem selben ersten Wert beginnen, nach dem 2. Wert sortiert werden und diese wieder nach dem 3. und diese letztendlich nach dem 4.

Erst habe ich es mit Potenzen der jeweiligen Werte versucht, dann habe ich versucht einfach das “/” durch “0” zu ersetzen und danach sortiert und und und.
Keiner meiner bisherigen Anstze hat mich auch nur annhernd zum gewnschten Ergebnis gefhrt.

Mag mir bitte jemand auf die Sprnge helfen? Vielen Dank. :slight_smile:

Event CompareRows(Row1 as Integer, Row2 as Integer, Column as Integer, ByRef Result as Integer) As Boolean Dim cell1 As String = Me.Cell(row1, column) Dim cell2 As String = Me.Cell(row2, column) Dim parts1() As String = cell1.Split("/") Dim parts2() As String = cell2.Split("/") Dim v10 As Integer = parts1(0).Val Dim v11 As Integer = parts1(1).Val Dim v12 As Integer = parts1(2).Val Dim v13 As Integer = parts1(3).Val Dim v20 As Integer = parts2(0).Val Dim v21 As Integer = parts2(1).Val Dim v22 As Integer = parts2(2).Val Dim v23 As Integer = parts2(3)v If v10 < v20 Then Return -1 ElseIf v10 > v20 Then Return 1 Else If v11 < v21 Then Return -1 ElseIf v11 > v21 Then Return 1 Else If v12 < v22 Then Return -1 ElseIf v12 > v22 Then Return 1 Else If v13 < v23 Then Return -1 ElseIf v13 > v23 Then Return 1 Else Return 0 End End End End End
Nicht getestet, da ich zurzeit nicht vor einem Computer bin.

Thank you, I am sure this won’t do it @Eli Ott . Because once you Return (True/False) the decision is done and the next Row will be compared.

Menno… sorry. Ich dachte ich hätte auf deutsch geantwortet… :confused:

Ich habe es eben testen können. Leider bringt der Code ähnliche Ergebnisse wie meine eigenen Versuche bisher.

Ich denke ich sollte die Werte zerlegen und abhngig vom vorherigen Ergebnis, ber alle 4 Werte arbeiten.
Z.Zt. versuche ich verzweifelt 15 freie Minuten fr ein paar Tests zu finden…

Anbei, mein letzter erfolgloser Versuch:

[code]Dim A(-1) As Integer
Dim B(-1) As Integer
Dim X,Y As Integer
Dim CellA(-1) As String = Me.Cell(row1, column).Split("/")
Dim CellB(-1) As String = Me.Cell(row2, column).Split("/")

y = UBound(CellA)

If Y = UBound(CellB) Then

For X = 0 To Y

A.Append CDbl(CellA(X))
B.Append CDbl(CellB(X))

Next

For X = 0 To Y

If A(X) > B(X) Then
  Result = Result + 1
ElseIf A(X) < B(X) Then
  Result = Result - 1
End If

Next

Return True

End If[/code]

Wandle

1/1/3/12
0/1/3/12
1/2/1/0
2/0/0/1
0/1/2/1

um in

01/01/03/12
00/01/03/12
01/02/01/00
02/00/00/01
00/01/02/01

(padding!) und benutze SortWith.

Oder wandel es in die richtigen Zahlen um, also

1010312
10312
1020100
2000001
10201

und sortier nach WERT, nicht alphabetisch.

[Ich vermute übrigens stark daß deine Umwandlung in Zahlen mit Potenzen einen Fehler enthielt da es das gleiche ist]

Oder steck den Sortierwert in den CellTag und vergleiche die CellTag-Werte

Sub Open() Handles Open me.AddRow"1/1/3/12" me.AddRow"0/1/3/12" me.AddRow"1/2/1/0" me.AddRow"2/0/0/1" me.AddRow"0/1/2/1" End Sub

[code]Public Function Pad(s as String) as String

dim PaddingLength as integer = 2

dim t() as string = split( s, “/” )

for i as integer = 0 to t.Ubound

while t(i).Len < PaddingLength

t(i) = "0" + t(i)

wend

next

return Join(t, “/” )

End Function[/code]

[code]Function CompareRows(row1 as Integer, row2 as Integer, column as Integer, ByRef result as Integer) Handles CompareRows as Boolean

Select Case column

Case 0

dim s1 as String = Pad( me.Cell( row1, 0 ) )

dim s2 as String = Pad( me.Cell( row2, 0 ) )

If s1 < s2 Then
result = -1
ElseIf s1 > s2 Then
result = 1
Else
result = 0
End if

Return True

Else //some other column for which we let the listbox handle comparison
Return false
End Select

End Function[/code]

You can minimise calling the pad function by creating the padded value just once and storing the result in the cellTag and comparing CellTags.

Danke @Markus Winter ! Das war’s :slight_smile:

[code]If column = 0 Then

Dim A As String
Dim B As String
Dim X,Y As Integer
Dim CellA(-1) As String = Me.Cell(row1, column).Split("/")
Dim CellB(-1) As String = Me.Cell(row2, column).Split("/")

y = UBound(CellA)

If Y = UBound(CellB) Then

For X = 0 To Y
  
  A = A + Str((99 - CDbl(CellA(X))))
  B = B + Str((99 - CDbl(CellB(X))))
  
Next

result = Sign(Val(B) - Val(A))

Return True

End If

End If[/code]

BTW: Es handelt sich bei diesen Werten um Slots an DSL MFG’s. Diese haben Karten mit je max. 96 Slots. Darum mein Quick&Dirty “99-…” Ansatz.

Habe momentan leider nicht genug Zeit um die Methode effektiver zu gestallten. Kümmere mich wieder drum wenn die Performanz zu sehr leiden sollte. :wink:

Danke noch einmal an alle Beteiligten.

PS: Sollte ich jetzt meinen Code als Lösung markieren oder Markus Hinweise?

Deinen Code.

P.S. Was aber passiert wenn UBound(CellA) nicht gleich mit UBound(CellB) ist?

Und wenn sie immer gleich sind dann braucht es eigentlich auch keinen Vergleich …

[quote=349071:@Markus Winter]P.S. Was aber passiert wenn UBound(CellA) nicht gleich mit UBound(CellB) ist?

Und wenn sie immer gleich sind dann braucht es eigentlich auch keinen Vergleich …[/quote]

Sie sollten immer gleich sein, werden aber manuell eingetragen (könnten also aufgrund fehlerhafter Eingabe, abweichen).
Sollte da aber mal ein Fehlerhafter Eintrag stehen, darf dieser ruhig irgendwo in der Liste stehen.

Meine Daten haben die Zahlen am Ende. Daraus folgt die Form des Regex. Ich verwende das alte SortFramework von Charles Yeomans. Der folgende Code ist ein neuer Comparator:

[code]Public Function Compare(s1 as String, s2 as String) as Integer
// Part of the StringComparator interface.

const NSCaseInsensitiveSearch = 1

dim theRegex as new RegEx
theRegex.searchPattern = “(.*)(\d)+”

'if one of the search texts doesn’t contain a number it doesn’t matter
dim theRegexMatch as RegExMatch = theRegex.search(s1)
if theRegexMatch = nil then
Return NSStringCompareMBS(s1, s2, NSCaseInsensitiveSearch)
else
s1 = theRegexMatch.subExpressionString(1) + Right(“00000” + theRegexMatch.subExpressionString(2), 5)
end if
theRegexMatch = theRegex.search(s2)
if theRegexMatch = nil then
Return NSStringCompareMBS(s1, s2, NSCaseInsensitiveSearch)
else
s2 = theRegexMatch.subExpressionString(1) + Right(“00000” + theRegexMatch.subExpressionString(2), 5)
end if

Return NSStringCompareMBS(s1, s2, NSCaseInsensitiveSearch)
End Function[/code]

Wird aufgerufen mit:

SortLibrary.Sort(AccountNames, new NaturalSortComparator)

@Sascha: better mark my code as the solution as your code isn’t working correctly :wink:

Something was bothering me the whole time and I finally got it. Try the following and see for yourself:

me.AddRow"1/1/93/12"
me.AddRow"1/1/95/12"
me.AddRow"1/1/97/12"
me.AddRow"1/1/4/12"
me.AddRow"1/1/6/12"
me.AddRow"1/2/93/12"
me.AddRow"1/2/95/12"
me.AddRow"1/2/97/12"
me.AddRow"1/2/4/12"
me.AddRow"1/2/6/12"

As you do no real padding the comparison fails when you reach the numbers 90 to 96 as the result of 99-9x is a single digit and consequently the number is a digit shorter aka 10fold smaller and you’ll sort wrong:

1/1/4/12
1/1/6/12
1/2/4/12
1/2/6/12
1/1/93/12
1/1/95/12
1/1/97/12
1/2/93/12
1/2/95/12
1/2/97/12

whereas my code results (as it should be) in

1/1/4/12
1/1/6/12
1/1/93/12
1/1/95/12
1/1/97/12
1/2/4/12
1/2/6/12
1/2/93/12
1/2/95/12
1/2/97/12

Danke Markus. Ich denke ich werde morgen Zeit finden Deine Lösung in mein Programm zu übernehmen.
Vielen herzlichen Dank für Eure Hilfe und besonderen Dank an Markus. :slight_smile:

[quote=349040:@Sascha S]Thank you, I am sure this won’t do it @Eli Ott . Because once you Return (True/False) the decision is done and the next Row will be compared.

Menno… sorry. Ich dachte ich hätte auf deutsch geantwortet… :confused:

Ich habe es eben testen können. Leider bringt der Code ähnliche Ergebnisse wie meine eigenen Versuche bisher.[/quote]
Mein Fehler war, dass ich in Gedanken bei einer anderen Sortier-Funktion war. Der Return bei CompareRows hat einer andere Funktion – ByRef result wäre richtig gewesen. Das wäre der korrekte Code gewesen:

[code]Dim cell1 As String = Me.Cell(row1, column)
Dim cell2 As String = Me.Cell(row2, column)
Dim parts1() As String = cell1.Split("/")
Dim parts2() As String = cell2.Split("/")
Dim v10 As Integer = parts1(0).Val
Dim v11 As Integer = parts1(1).Val
Dim v12 As Integer = parts1(2).Val
Dim v13 As Integer = parts1(3).Val
Dim v20 As Integer = parts2(0).Val
Dim v21 As Integer = parts2(1).Val
Dim v22 As Integer = parts2(2).Val
Dim v23 As Integer = parts2(3).Val
If v10 < v20 Then
result = -1
ElseIf v10 > v20 Then
result = 1
Else
If v11 < v21 Then
result = -1
ElseIf v11 > v21 Then
result = 1
Else
If v12 < v22 Then
result = -1
ElseIf v12 > v22 Then
result = 1
Else
If v13 < v23 Then
result = -1
ElseIf v13 > v23 Then
result = 1
Else
result = 0
End
End
End
End

Return True[/code]

Funktioniert wunderbar. Danke @Markus Winter