Clever-Excel-Forum

Normale Version: Windows 11 / StrPtr geht nicht mehr bei QuickSort
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Guten Tag miteinander 
Habe jemand von Euch eine Idee wie ich den Fehler bei StrPtr lösen kann. Auf Windows 11 bleibt es stehen?
Vielen Dank für Eure Hilfe.
Gruss
Stefan




Public Sub QuickSort_s(ByRef vSort() As String, Optional ByVal lngStart As Long, Optional ByVal lngEnd As Long)
Dim i As Long
Dim j As Long
Dim x As String
Dim N As Long
Dim nPtr As Long
    'Wird die Bereichsgrenze nicht angegeben,
    'so wird das gesamte Array sortiert
    If IsMissing(lngStart) Then lngStart = LBound(vSort)
    If IsMissing(lngEnd) Then lngEnd = UBound(vSort)
    '---------------------------------------------------------------
    'ErrorHandler
    On Error Resume Next
   
    '---------------------------------------------------------------
    If Err.Number <> 0 Then Err.Clear
    i = lngStart: j = lngEnd: N = ((lngStart + lngEnd) \ 2)
    x = vSort(N)
    'Array aufteilen
    Do
        Do While (StrComp(vSort(i), x, vbTextCompare) = -1): i = i + 1: Loop
        Do While (StrComp(vSort(j), x, vbTextCompare) = 1): j = j - 1: Loop
        If (i <= j) Then
            'Wertepaare miteinander tauschen
            nPtr = StrPtr(vSort(i))
            CopyMemoryPtr VarPtr(vSort(i)), VarPtr(vSort(j)), Len(nPtr)
            CopyMemoryPtr VarPtr(vSort(j)), VarPtr(nPtr), Len(nPtr)
            i = i + 1: j = j - 1
        End If
    Loop Until (i > j)
    'Rekursion (Funktion ruft sich selbst auf)
    If (lngStart < j) Then QuickSort_s vSort, lngStart, j
    If (i < lngEnd) Then QuickSort_s vSort, i, lngEnd
    On Error GoTo 0
End Sub
...das hat nichts mit Win11 zu tun, sondern damit, ob Du ein 32er oder ein 64 Bit System nutzt. StrPtr, ist für 64 Bit, und Du wirst Deinen Code vermutlich auf einem 32 Bit System ausführen wollen...

Wie Du das händeln kannst, kannst Du mit @VOLTI's API Viewer sehen.
Guten Tag Ralf

Vielen Dank für den Hinweis. Ja, das stimmt. Vielen Dank für Deine Unterstützung. Ich kann leider hier auf dem Geschäftsrechner den Anhang nicht öffnen. Was ich jetzt mal versuche um StrPtr zu umgehen ist folgender Code, welcher StrPtr umgeht:

Public Sub QuickSort_s(vSort As Variant, _
  Optional ByVal lngStart As Variant, _
  Optional ByVal lngEnd As Variant)

  ' Wird die Bereichsgrenze nicht angegeben,
  ' so wird das gesamte Array sortiert

  If IsMissing(lngStart) Then lngStart = LBound(vSort)
  If IsMissing(lngEnd) Then lngEnd = UBound(vSort)

  Dim i As Long
  Dim j As Long
  Dim h As Variant
  Dim x As Variant

  i = lngStart: j = lngEnd
  x = vSort((lngStart + lngEnd) / 2)

  ' Array aufteilen
  Do

    While (vSort(i) < x): i = i + 1: Wend
    While (vSort(j) > x): j = j - 1: Wend

    If (i <= j) Then
      ' Wertepaare miteinander tauschen
      h = vSort(i)
      vSort(i) = vSort(j)
      vSort(j) = h
      i = i + 1: j = j - 1
    End If
  Loop Until (i > j)

  ' Rekursion (Funktion ruft sich selbst auf)
  If (lngStart < j) Then QuickSort_s vSort, lngStart, j
  If (i < lngEnd) Then QuickSort_s vSort, i, lngEnd
End Sub