06.02.2024, 12:25
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
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