Alphanumerical sort

[elziko]

I have an array of data, which contains some number and then some letters. Niether the amount of number in the numbers part, nor the number of letters in the letter part is constant:

BT1A
BT1AB
BT1B
BT2A
BT2AB
BT2B
BT11A
BT11AB
BT11B
BT19A
BT19AB
BT19B
BT20A
BT20AB
BT20B

IE. the numbers are more significant than the letters.

However the "BT" at the start of the string IS constant. How would I sort an array into the order described as above? I cant figure out a way of doing it that wont require silly amounts of code!

I hope I'm making sense today.

Thanks,

elziko

 

[MichaelRed]

elziko,

Well, this obviously needs to be rotted out (descomposed?) to even come close.

It is a bit weird, but not that hard. There are two routines below, one which actually does the sorting - and one just to test it (the one which does the sorting).

The second one (the tester) isn't really necessary for you at all, but since i had to do it - you are going to get it.

The first does the work - for your sample. You WILL need to enhance it, as the array sizes are "FIXED", and your data will almost certainly not be, so you need to set it up to dynamically size the arrays. Other than that, I believe it will work.


MichaelRed
redmsp@erols.com

There is never time to do it right but there is always time to do it over

 

[elziko]

I dont see any code below!

Anyway I have it almost sorted now. I'm giving each character in the string a number between 1 and 26.

Any numbers in the string keep their value.

I then multiply this by 26 raised to the power of its position (from the right) in the string. This gives a higher "weighting" to characters residing to the left of the string.

Each character's weighting is then summed to give an overall weighting for that string.

Each string is then stored in a 2D array along with its weighting which is then bubble sorted.

Whaddaya Think????? Almost clever I reckon and theres not much code to it. Or do you think its a but convoluted?

Many thanks

elziko

 

[MichaelRed]

Oops. Brain Flatulence!

Public Function basAlphNumSort(strArray) As Boolean

    'BT1A
    'BT1AB
    'BT1B
    'BT2A
    'BT2AB
    'BT2B
    'BT11A
    'BT11AB
    'BT11B
    'BT19A
    'BT19AB
    'BT19B
    'BT20A
    'BT20AB
    'BT20B

    Dim Grp As Integer
    Dim Alph As Boolean
    Dim LastAlph As Boolean
    Dim MyChr As String * 1
    Dim strSort(14, 3)           'Str | Num | StrII

    If (UBound(strSort, 1) < 1) Then
        Exit Function
    End If

    For Idx = 0 To UBound(strSort)
        strcurstr = strArray(Idx)
        Grp = 1
        LastAlph = True
        'Got an element, so start over w/ parse
        For Jdx = 1 To Len(strcurstr)
            MyChr = Mid(strcurstr, Jdx)
            Alph = UCase(MyChr) >= &quot;A&quot; And UCase(MyChr) <= &quot;Z&quot;
            If (Alph <> LastAlph) Then
                Grp = Grp + 1
            End If
            strSort(Idx, Grp) = strSort(Idx, Grp) & MyChr
            LastAlph = Alph
        Next Jdx
    Next Idx
    
    'Do any sort you want on strSort.
    'Just use the middle item for the SORT

    Sorted = False
    For Idx = 0 To UBound(strSort, 1)

        If (Sorted) Then                'Still Sorter?
            Exit For                    'Time to quit
        End If

        Sorted = True                   'Expect the best

        For Jdx = 0 To UBound(strSort, 1) - 1
            Kdx = Jdx + 1
            If (Val(strSort(Jdx, 2)) > Val(strSort(Kdx, 2))) Then
                'Not in Order, so swap the elements
                tmp1 = strSort(Jdx, 1)
                tmp2 = strSort(Jdx, 2)
                tmp3 = strSort(Jdx, 3)
                strSort(Jdx, 1) = strSort(Kdx, 1)
                strSort(Jdx, 2) = strSort(Kdx, 2)
                strSort(Jdx, 3) = strSort(Kdx, 3)
                strSort(Kdx, 1) = tmp1
                strSort(Kdx, 2) = tmp2
                strSort(Kdx, 3) = tmp3
                'and take down the sorted flag
                Sorted = False
            End If
        Next Jdx
    Next Idx

    'After the sort, Re-concatenate the three element array
    'into the original string array in the sorted order.

    For Idx = 0 To UBound(strSort, 1)
    strArray(Idx) = &quot;&quot;
        For Jdx = 1 To 3
            strArray(Idx) = strArray(Idx) & strSort(Idx, Jdx)
        Next Jdx

        Debug.Print Idx, strArray(Idx)

    Next Idx
End Function

Public Function basTestAnSort()

    ReDim MyStr(14)
    
    Dim TstStr(14) As String
    Dim MyIdx(14) As Integer
    Dim MyInt As Integer
    Dim blnIdxUsed(14) As Boolean

    TstStr(0) = &quot;BT1A&quot;
    TstStr(1) = &quot;BT1AB&quot;
    TstStr(2) = &quot;BT1B&quot;
    TstStr(3) = &quot;BT2A&quot;
    TstStr(4) = &quot;BT2AB&quot;
    TstStr(5) = &quot;BT2B&quot;
    TstStr(6) = &quot;BT11A&quot;
    TstStr(7) = &quot;BT11AB&quot;
    TstStr(8) = &quot;BT11B&quot;
    TstStr(9) = &quot;BT19A&quot;
    TstStr(10) = &quot;BT19AB&quot;
    TstStr(11) = &quot;BT19B&quot;
    TstStr(12) = &quot;BT20A&quot;
    TstStr(13) = &quot;BT20AB&quot;
    TstStr(14) = &quot;BT20B&quot;

    For Idx = 0 To 14
        MyIdx(Idx) = Int(Rnd() * 14)
        blnIdxUsed(Idx) = False
    Next Idx

    Kdx = UBound(MyIdx) - 1

    For Idx = 0 To Kdx
        For Jdx = Idx + 1 To Kdx + 1
            If (MyIdx(Idx) = MyIdx(Jdx)) Then
                MyIdx(Jdx) = -1
            End If
        Next Jdx
        If (MyIdx(Idx) <> -1) Then
            blnIdxUsed(MyIdx(Idx)) = True
        End If
    Next Idx

    For Idx = 0 To Kdx + 1
        If (MyIdx(Idx) = -1) Then
            'Not a valid index, Replace it
            For Jdx = 0 To Kdx + 1
                If (Not blnIdxUsed(Jdx)) Then
                    MyIdx(Idx) = Jdx
                    blnIdxUsed(Jdx) = True
                    Exit For
                End If
            Next Jdx
        End If

    Next Idx

    For Idx = 0 To UBound(MyStr)
        MyStr(Idx) = TstStr(MyIdx(Idx))
    Next Idx

    Call basAlphNumSort(MyStr)

End Function

MichaelRed
redmsp@erols.com

There is never time to do it right but there is always time to do it over