Sorterings algoritme til sortering af ord

Jeg kan ikke forstå hvor du vil gøre det, men det må være din ejen sag. ;)

Dette er ikke en løsning, men snarer en ide.
Hvad hvis du laver et nyt array hvor du 'oversætter' dine tekststrenge sådan at du erstatter 'k' med 'a', j med 'b' osv. dermed kan du lave en normal alfabetisk sortering. Du kan så enten gemme information om hvilket felt det er du har oversat, eller oversætte tilbage.

Oswald

Public MyArray() As String
Public Alfa As String

Public Function test()
  MyArray() = Split("jens¤jakob¤jacob¤klaus", "¤")
  Alfa = "kjaebcdfghijklmnopqrst" & "abcdefghijklmnopqrstuvwxyz"
  TranslateToAlfa
  QuickSort MyArray()
TranslateToNormal
  For i = LBound(MyArray) To UBound(MyArray)
    Debug.Print i, MyArray(i)
  Next
End Function

Private Function TranslateToAlfa()
  Dim lLoop As Long, iLoop As Integer
  For lLoop = LBound(MyArray) To UBound(MyArray)
    For iLoop = 1 To Len(MyArray(lLoop))
      MyArray(lLoop) = Left(MyArray(lLoop), iLoop - 1) & Chr$(InStr(Alfa, Mid(MyArray(lLoop), iLoop, 1)) + 64) & Mid(MyArray(lLoop), iLoop + 1)
    Next
  Next
End Function

Private Function TranslateToNormal()
  Dim lLoop As Long, iLoop As Integer
  For lLoop = LBound(MyArray) To UBound(MyArray)
    For iLoop = 1 To Len(MyArray(lLoop))
      MyArray(lLoop) = Left(MyArray(lLoop), iLoop - 1) & Mid(Alfa, Asc(Mid(MyArray(lLoop), iLoop, 1)) - 64, 1) & Mid(MyArray(lLoop), iLoop + 1)
    Next
  Next
End Function

Private Function QuickSort(varArray As Variant, Optional lngFirst As Long = -1, Optional lngLast As Long = -1) As Variant
  Dim lngLow As Long, lngHigh As Long, lngMiddle As Long
  Dim varTempVal As Variant, varTestVal As Variant
  If lngFirst = -1 Then lngFirst = LBound(varArray)
  If lngLast = -1 Then lngLast = UBound(varArray)
  If lngFirst < lngLast Then
    lngMiddle = (lngFirst + lngLast) / 2
    varTestVal = varArray(lngMiddle)
    lngLow = lngFirst
    lngHigh = lngLast
    Do
      Do While varArray(lngLow) < varTestVal
        lngLow = lngLow + 1
      Loop
      Do While varArray(lngHigh) > varTestVal
        lngHigh = lngHigh - 1
      Loop
      If (lngLow <= lngHigh) Then
        varTempVal = varArray(lngLow)
        varArray(lngLow) = varArray(lngHigh)
        varArray(lngHigh) = varTempVal
        lngLow = lngLow + 1
        lngHigh = lngHigh - 1
      End If
    Loop While (lngLow <= lngHigh)
    If lngFirst < lngHigh Then QuickSort varArray, lngFirst, lngHigh
    If lngLow < lngLast Then QuickSort varArray, lngLow, lngLast
  End If
End Function

Tak for hjælpen begge to, jeg har dog løst mit problem med følgende Quicksort:

Private Function Swap(ByRef arrToSwapIn() As String, x As Long, y As Long)

    Dim sTemp As String
   
        sTemp = arrToSwapIn(x)
        arrToSwapIn(x) = arrToSwapIn(y)
        arrToSwapIn(y) = sTemp
 
End Function

Private Function Partition(ByRef arrArray() As String, ByVal lLow As Long, ByVal lHigh As Long, ByRef lPivot As Long)

    Dim sCurrent As String
    Dim i As Long
    Dim j As Long
    Dim lResult As Long
   

    sCurrent = arrArray(lLow)
    i = lLow + 1
    j = lHigh
   
    While i <= j
        Call WhitchIsFirstInAlpha(arrArray(i), sCurrent, lResult)
        If lResult = 1 Or lResult = 0 Then
            i = i + 1
        Else
            Call WhitchIsFirstInAlpha(arrArray(j), sCurrent, lResult)
            If lResult = 2 Then
                j = j - 1
            Else
                Call WhitchIsFirstInAlpha(arrArray(i), sCurrent, lResult)
                If lResult = 2 Then
                    Call WhitchIsFirstInAlpha(arrArray(j), sCurrent, lResult)
                    If lResult = 1 Or lResult = 0 Then
                        Call Swap(arrArray, i, j)
                        i = i + 1
                        j = j - 1
                    End If
                End If
            End If
        End If
    Wend
   
    lPivot = j
   
    Call Swap(arrArray, lLow, lPivot)
   
End Function

Private Function QuickSort(ByRef arrArray() As String, lLow As Long, lHigh As Long)
    Dim lPivot As Long
    If lLow < lHigh Then
        Call Partition(arrArray, lLow, lHigh, lPivot)
        Call QuickSort(arrArray, lLow, lPivot - 1)
        Call QuickSort(arrArray, lPivot + 1, lHigh)
    End If
   

End Function



Public Function WhitchIsFirstInAlpha(sString1 As String, sString2 As String, ByRef lIsFirstInAlpha As Long)
    Dim sString1AsNumbers As String
    Dim sString2AsNumbers As String
    Dim arr1() As String
    Dim arr2() As String
    Dim lShortestArrLength As Long
    Dim i
    For i = 1 To Len(sString1)
        sString1AsNumbers = sString1AsNumbers & "," & dicAlpha(Mid(sString1, i, 1))
    Next
    sString1AsNumbers = Mid(sString1AsNumbers, 2)
   
    arr1 = Split(sString1AsNumbers, ",")
   
   
    For i = 1 To Len(sString2)
        sString2AsNumbers = sString2AsNumbers & "," & dicAlpha(Mid(sString2, i, 1))
    Next
    sString2AsNumbers = Mid(sString2AsNumbers, 2)
   
    arr2 = Split(sString2AsNumbers, ",")
   
    If UBound(arr1) < UBound(arr2) Then
        lShortestArrLength = UBound(arr1)
    Else
        lShortestArrLength = UBound(arr2)
    End If
   
   
   
    For i = 0 To lShortestArrLength
        If CLng(arr1(i)) < CLng(arr2(i)) Then
            lIsFirstInAlpha = 1
            Exit Function
        End If
       
        If CLng(arr1(i)) > CLng(arr2(i)) Then
            lIsFirstInAlpha = 2
            Exit Function
        End If
    Next
   
   
    lIsFirstInAlpha = 0
End Function