Mai 17, 2021, 15:23:51

Neuigkeiten:

Wenn ihr euch für eine gute Antwort bedanken möchtet, im entsprechenden Posting einfach den Knopf "sag Danke" drücken!


Natürliche Sortierung

Begonnen von crystal, August 12, 2016, 18:44:05

⏪ vorheriges - nächstes ⏩

Hondo

Hallo,
clever gelöst! Ihr habt auch an alles gedacht. Auf das Gebietsschema wäre ich nicht gekommen.

Gruß Andreas

crystal

Hallo daolix, MzKlMa, Lachtaube und PhilS,

Natürlich gebührt der "Ruhm für diese tolle Lösung" euch allen.

Speziellen Dank an PhilS für den Artikel auf deiner Website: er ist auch didaktisch hervorragend!

Solche Threads und Lösungen sind wirklich fantastisch für ein aktives Access- und VBA-Forum. Ich bin mir sicher, dass die Lösung bald weiter bekannt wird und weltweite Beachtung findet.

Bravo!

Wer Fehler in meinen Antworten findet, darf sie behalten, muss sie aber kommentieren. ;-)
Dies ist keineswegs arrogant gemeint, sondern soll nur unterstreichen, dass meine Antworten - natürlich - nicht immer fehlerfrei sind und sein können.
Devise: bitte immer erst selbst probieren!

Aus gesundheitlichen Gründen nur noch selten dabei...

crystal

Hallo,
soeben habe ich den Thread-Titel auf "Natürliche Sortierung" geändert, damit die tolle Lösung vielleicht noch einfacher gefunden werden kann.

Bitte, liebe Mods, erstellt ein neues Unterfoum "Excellente Lösungen" oder ähnlich, um solche Threads zusammenfassen zu können.

Wer Fehler in meinen Antworten findet, darf sie behalten, muss sie aber kommentieren. ;-)
Dies ist keineswegs arrogant gemeint, sondern soll nur unterstreichen, dass meine Antworten - natürlich - nicht immer fehlerfrei sind und sein können.
Devise: bitte immer erst selbst probieren!

Aus gesundheitlichen Gründen nur noch selten dabei...

Hondo

Hallo,
danke für den Vorschlag, wir werden darüber nachdenken.

Andreas

crystal

Noch eine kleine Verbesserung der Performance (Speichern des Sortwerts in der Tabelle selbst).
Die Idee ist lediglich, alle Hex-Strings der Zahlen 0 bis 255 >>>einmal<<<  zu erzeugen und dann nur noch zu referenzieren.

Die alte Version braucht für 10.000 Datensätze ca. 6 Sekunden, die neue unter 1 Sekunde - ohne Garantie. (Änderungen siehe Kommentar "'crystal".)


Option Compare Database
Option Explicit

Private Const LOCALE_NAME_USER_DEFAULT$ = vbNullString
Private Const LCMAP_SORTKEY& = &H400            ' // WC sort key (normalize)
Private Const SORT_DIGITSASNUMBERS& = &H8       ' // use digits as numbers sort method

#If VBA7 Then
Private Declare PtrSafe Function LCMapStringEx Lib "kernel32" ( _
   ByVal lpLocaleName As LongPtr _
, ByVal dwMapFlags As Long _
, ByVal lpSrcStr As LongPtr _
, ByVal cchSrc As Long _
, ByVal lpDestStr As LongPtr _
, ByVal cchDest As Long _
, Optional ByVal lpVersionInformation As LongPtr _
, Optional ByVal lpReserved As LongPtr _
, Optional ByVal lParam As Long _
) As Long
#Else
Private Declare Function LCMapStringEx Lib "kernel32" ( _
   ByVal lpLocaleName As Long _
, ByVal dwMapFlags As Long _
, ByVal lpSrcStr As Long _
, ByVal cchSrc As Long _
, ByVal lpDestStr As Long _
, ByVal cchDest As Long _
, Optional ByVal lpVersionInformation As Long _
, Optional ByVal lpReserved As Long _
, Optional ByVal lParam As Long _
) As Long
#End If

Public strH As String               'crystal
Public sHex                         'crystal
Public blnInitialized As Boolean    'crystal
'

'// Zur Verwendung als Sortierschlüssel geeignet
'// Ausgabe als Hex-String
Public Function GetMappedStringArrayAsHex(ByVal Source)
   Dim i&, r&, dest() As Byte

   If Len(Nz(Source)) = 0 Then Exit Function

   '// erforderliche Länge ermitteln
   r = LCMapStringEx(StrPtr(LOCALE_NAME_USER_DEFAULT), _
                     LCMAP_SORTKEY Or SORT_DIGITSASNUMBERS, _
                     StrPtr(Source), Len(Source), 0, 0)
   If r > 0 Then
      '// Ziel-Array dimensionieren
      ReDim dest(r - 1)
      '// Ziel-Array füllen
      r = LCMapStringEx(StrPtr(LOCALE_NAME_USER_DEFAULT), _
                        LCMAP_SORTKEY Or SORT_DIGITSASNUMBERS, _
                        StrPtr(Source), Len(Source), _
                        VarPtr(dest(0)), r)
                       
      '// Ergebnispuffer mit Leerzeichen initialisieren
      GetMappedStringArrayAsHex = Space$(2 * (r - 1))

      '// 0-Byte am Ende ignorieren
      For i = 0 To UBound(dest) - 1
         Mid$(GetMappedStringArrayAsHex, 2 * i + 1, 2) _
               = GetHex(dest(i))                                'crystal
'               = Right$("00" & Hex$(dest(i)), 2)               'crystal
      Next
   Else
      GetMappedStringArrayAsHex = CVErr(vbObjectError + &H2001)
   End If
End Function

Public Function GetHex(ByVal intValue) As String                'crystal

    If Not blnInitialized Then
        strH = "00,01,02,03,04,05,06,07,08,09,0A,0B,0C,0D,0E,0F," & _
               "10,11,12,13,14,15,16,17,18,19,1A,1B,1C,1D,1E,1F," & _
               "20,21,22,23,24,25,26,27,28,29,2A,2B,2C,2D,2E,2F," & _
               "30,31,32,33,34,35,36,37,38,39,3A,3B,3C,3D,3E,3F," & _
               "40,41,42,43,44,45,46,47,48,49,4A,4B,4C,4D,4E,4F," & _
               "50,51,52,53,54,55,56,57,58,59,5A,5B,5C,5D,5E,5F," & _
               "60,61,62,63,64,65,66,67,68,69,6A,6B,6C,6D,6E,6F," & _
               "70,71,72,73,74,75,76,77,78,79,7A,7B,7C,7D,7E,7F," & _
               "80,81,82,83,84,85,86,87,88,89,8A,8B,8C,8D,8E,8F," & _
               "90,91,92,93,94,95,96,97,98,99,9A,9B,9C,9D,9E,9F," & _
               "A0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF," & _
               "B0,B1,B2,B3,B4,B5,B6,B7,B8,B9,BA,BB,BC,BD,BE,BF," & _
               "C0,C1,C2,C3,C4,C5,C6,C7,C8,C9,CA,CB,CC,CD,CE,CF," & _
               "D0,D1,D2,D3,D4,D5,D6,D7,D8,D9,DA,DB,DC,DD,DE,DF," & _
               "E0,E1,E2,E3,E4,E5,E6,E7,E8,E9,EA,EB,EC,ED,EE,EF," & _
               "F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,FA,FB,FC,FD,FE,FF,"
               
        sHex = Split(strH, ",")
        blnInitialized = True
    End If
   
    GetHex = sHex(intValue)
   
End Function



Das ganze mit dieser Abfrage:



UPDATE Produkte SET Produkte.SortName = GetMappedStringArrayAsHex(Produkte.Name);


Vielleicht könnte man die Performance noch weiter verbessern, wenn man das Ziel-Array "dest" nicht bei jedem Aufruf neu bildet, sondern nur einmal public definiert und z. B. auf eine Länge von 1024 Zeichen initialisiert. Dann könnte man den zweifachen Aufruf von LCMapStringEx auf einen reduzieren und müßte nur noch auf r<1024 prüfen.


Nur Ideen....sicher verbesserungsfähig....

Gruß,

crystal
Wer Fehler in meinen Antworten findet, darf sie behalten, muss sie aber kommentieren. ;-)
Dies ist keineswegs arrogant gemeint, sondern soll nur unterstreichen, dass meine Antworten - natürlich - nicht immer fehlerfrei sind und sein können.
Devise: bitte immer erst selbst probieren!

Aus gesundheitlichen Gründen nur noch selten dabei...

daolix

Hallo
ZitatDann könnte man den zweifachen Aufruf von LCMapStringEx auf einen reduzieren

Könnte man machen, aber ich glaube nicht das das zu einer signifikanten Verbesserung führt. Der Performancefresser ist hier die Hexbildung.
Und hier könnte man ggf statt mit der Mid-Funktion [Mid$(GetMappedStringArrayAsHex ...] mit einem Pointer und CopyMemory arbeiten. Aber sehr viel mehr wird man mit VB(A) nicht mehr rauskizueln können.

PhilS

Zitat von: crystal am Oktober 01, 2016, 20:24:47
Noch eine kleine Verbesserung der Performance (Speichern des Sortwerts in der Tabelle selbst).
Die Idee ist lediglich, alle Hex-Strings der Zahlen 0 bis 255 >>>einmal<<<  zu erzeugen und dann nur noch zu referenzieren.

Wenn du den SortKey in einer Tabelle speichern willst, solltest du direkt das Byte-Array als Binär-Datentyp speichern. Dieser hat im Vergleich eine wesentlich größere Speicherdichte, da es nur jeweils ein Byte für jedes Byte im Byte-Array benötigt. Der Hex-String hat seine Daseinsberechtigung nur als Rückgabewert einer Funktion, die ad-hoc in einer Abfrage aufgerufen wird, weil hier kein anderer, adäquater Datentyp möglich ist.

Wenn du das Byte-Array in einen Hex-String konvertierst und dann erst speicherst, verlierst du doppelt Speicherplatz. Erstmal, weil bei der Umwandlung in den Hex-String ein Byte zu zwei Zeichen wird und dann nochmal weil beim Speichern pro Zeichen zwei Bytes (Unicode) in der Tabelle belegt werden.

  • Binär in Tabelle (max. 510 Bytes) = Max 510 Bytes in Byte-Array (Speicherbedarf 1:1)

  • Text in Tabelle (max. 255 Zeichen) = Max 127 Bytes im Byte-Array (Speicherbedarf 4:1)


Weiterhin ist der Binär-Datentyp in der Tabelle sicherlich auch deshalb noch schneller, weil er auch Binär sortiert werden kann und keine spezielle Sortierreihenfolge dafür angewendet werden muss.


Die Idee einfach ein vordefiniertes Byte-Array der maximal verwertbaren Länge zu verwenden und ohne den ersten Aufruf von LCStringMapEx an die Funktion zu übergeben halte ich für eine Idee, die durchaus die Performance noch etwas verbessern kann.

Abhängig von den oben genannten Limits für die weitere Verwendung des ByteArray kann man einfach die maximale Länge an Bytes übergeben und muss den Rest ohnehin ignorieren. (Ich habe jetzt allerdings nicht geprüft, ob LCStringMapEx die ersten Bytes überhaupt in den Buffer schreibt, wenn vorher klar ist, dass die Gesamtlänge nicht ausreicht.

Evtl. macht es dann mehr Sinn, einfach einen noch größeren Buffer an die Funktion zu übergeben und dann den (zu großen) Rest des Arrays einfach zu verwerfen, weil man ihn ja eh nicht für die Sortierung benutzen kann. - Dies verursacht dann natürlich potenzielle Ungenauigkeiten bei der Sortierung von langen Texten.
Access DevTools - Find and Replace
Komfortables Suchen und Ersetzen in den Entwurfseigenschaften von Access-Objekten. In Abfragen, Formularen, Berichten und VBA-Code - Überall und rasend schnell!

crystal

Hallo PhilS,
danke für deine Hinweise und die ausführlichen Begründungen!
Wieder ein schönes Beispiel für exakte, verständliche und vollständige Hilfe ohne erhobenen Zeigefinger (und ohne Ironie oder Geringschätzung des Fragenden).
So müssen Beiträge in einem Forum geschrieben werden: sachlich, fachlich fundiert und konstruktiv.

Bravo! 5 von 5 Sternen für deinen Beitrag und dessen didaktische Qualität!

Gruß, crystal

Wer Fehler in meinen Antworten findet, darf sie behalten, muss sie aber kommentieren. ;-)
Dies ist keineswegs arrogant gemeint, sondern soll nur unterstreichen, dass meine Antworten - natürlich - nicht immer fehlerfrei sind und sein können.
Devise: bitte immer erst selbst probieren!

Aus gesundheitlichen Gründen nur noch selten dabei...

crystal

Hallo nochmal PhilS,

ich habe jetzt versucht, mit meiner Aktualisierungs-Abfrage ein biäres Feld zu erzeugen.

UPDATE Produkte SET Produkte.SortName = GetMappedStringArrayAsByteArray(Produkte.Name);


Das funktioniert aber leider nicht.
Erst wenn ich im Code


Public Function GetMappedStringAsByteArray(ByVal Source$) As Byte()


auf


Public Function GetMappedStringAsByteArray(ByVal Source$)


ändere, klappt es, sonst kommt nur der Fehler

Unbekannte Funktion "GetMappedStringAsByteArray".

Komisch, aber wahr...
Wer Fehler in meinen Antworten findet, darf sie behalten, muss sie aber kommentieren. ;-)
Dies ist keineswegs arrogant gemeint, sondern soll nur unterstreichen, dass meine Antworten - natürlich - nicht immer fehlerfrei sind und sein können.
Devise: bitte immer erst selbst probieren!

Aus gesundheitlichen Gründen nur noch selten dabei...

PhilS

Zitat von: crystal am Oktober 06, 2016, 17:37:01ich habe jetzt versucht, mit meiner Aktualisierungs-Abfrage ein biäres Feld zu erzeugen.
UPDATE Produkte SET Produkte.SortName = GetMappedStringArrayAsByteArray(Produkte.Name);
Das funktioniert aber leider nicht.
Erst wenn ich im Code

Public Function GetMappedStringAsByteArray(ByVal Source$) As Byte()
auf

Public Function GetMappedStringAsByteArray(ByVal Source$)
ändere, klappt es, sonst kommt nur der Fehler

Unbekannte Funktion "GetMappedStringAsByteArray".

Komisch, aber wahr...
Diesen Post hatte ich mir vor Jahren mal auf Wiedervorlage gelegt, und zufällig jetzt gerade wieder im Blick.

Mit dem Abstand ist das Problem hier relativ klar.
Funktionen können nur direkt in Abfragen verwendet werden, wenn sie primitive Datentypen (z.B. String, Zahl, Datum) zurückgeben, aber nicht mit komplexen Typen, wie einem Array.
Ein Byte-Array ist aber ja fast ein "binary". - Daher vermute ich, wenn man den Rückgabetyp der Funktion nicht explizit definiert, wird das Byte-Array implizit in einen Binary-Typ in der DB konvertiert.
Access DevTools - Find and Replace
Komfortables Suchen und Ersetzen in den Entwurfseigenschaften von Access-Objekten. In Abfragen, Formularen, Berichten und VBA-Code - Überall und rasend schnell!