Note that there are some explanatory texts on larger screens.

plurals
  1. PO
    text
    copied!<p><strong>Natural Number (Strings) Quick Sort</strong> </p> <p>Just to pile onto the topic. Normally, if you sort strings with numbers you'll get something like this:</p> <pre><code> Text1 Text10 Text100 Text11 Text2 Text20 </code></pre> <p>But you really want it to recognize the numerical values and be sorted like </p> <pre><code> Text1 Text2 Text10 Text11 Text20 Text100 </code></pre> <p>Here's how to do it...</p> <p>Note: </p> <ul> <li>I stole the Quick Sort from the internet a long time ago, not sure where now... </li> <li>I translated the CompareNaturalNum function which was originally written in C from the internet as well.</li> <li>Difference from other Q-Sorts: I don't swap the values if the BottomTemp = TopTemp</li> </ul> <p><strong>Natural Number Quick Sort</strong></p> <pre><code>Public Sub QuickSortNaturalNum(strArray() As String, intBottom As Integer, intTop As Integer) Dim strPivot As String, strTemp As String Dim intBottomTemp As Integer, intTopTemp As Integer intBottomTemp = intBottom intTopTemp = intTop strPivot = strArray((intBottom + intTop) \ 2) Do While (intBottomTemp &lt;= intTopTemp) ' &lt; comparison of the values is a descending sort Do While (CompareNaturalNum(strArray(intBottomTemp), strPivot) &lt; 0 And intBottomTemp &lt; intTop) intBottomTemp = intBottomTemp + 1 Loop Do While (CompareNaturalNum(strPivot, strArray(intTopTemp)) &lt; 0 And intTopTemp &gt; intBottom) ' intTopTemp = intTopTemp - 1 Loop If intBottomTemp &lt; intTopTemp Then strTemp = strArray(intBottomTemp) strArray(intBottomTemp) = strArray(intTopTemp) strArray(intTopTemp) = strTemp End If If intBottomTemp &lt;= intTopTemp Then intBottomTemp = intBottomTemp + 1 intTopTemp = intTopTemp - 1 End If Loop 'the function calls itself until everything is in good order If (intBottom &lt; intTopTemp) Then QuickSortNaturalNum strArray, intBottom, intTopTemp If (intBottomTemp &lt; intTop) Then QuickSortNaturalNum strArray, intBottomTemp, intTop End Sub </code></pre> <p><strong>Natural Number Compare(Used in Quick Sort)</strong></p> <pre><code>Function CompareNaturalNum(string1 As Variant, string2 As Variant) As Integer 'string1 is less than string2 -1 'string1 is equal to string2 0 'string1 is greater than string2 1 Dim n1 As Long, n2 As Long Dim iPosOrig1 As Integer, iPosOrig2 As Integer Dim iPos1 As Integer, iPos2 As Integer Dim nOffset1 As Integer, nOffset2 As Integer If Not (IsNull(string1) Or IsNull(string2)) Then iPos1 = 1 iPos2 = 1 Do While iPos1 &lt;= Len(string1) If iPos2 &gt; Len(string2) Then CompareNaturalNum = 1 Exit Function End If If isDigit(string1, iPos1) Then If Not isDigit(string2, iPos2) Then CompareNaturalNum = -1 Exit Function End If iPosOrig1 = iPos1 iPosOrig2 = iPos2 Do While isDigit(string1, iPos1) iPos1 = iPos1 + 1 Loop Do While isDigit(string2, iPos2) iPos2 = iPos2 + 1 Loop nOffset1 = (iPos1 - iPosOrig1) nOffset2 = (iPos2 - iPosOrig2) n1 = Val(Mid(string1, iPosOrig1, nOffset1)) n2 = Val(Mid(string2, iPosOrig2, nOffset2)) If (n1 &lt; n2) Then CompareNaturalNum = -1 Exit Function ElseIf (n1 &gt; n2) Then CompareNaturalNum = 1 Exit Function End If ' front padded zeros (put 01 before 1) If (n1 = n2) Then If (nOffset1 &gt; nOffset2) Then CompareNaturalNum = -1 Exit Function ElseIf (nOffset1 &lt; nOffset2) Then CompareNaturalNum = 1 Exit Function End If End If ElseIf isDigit(string2, iPos2) Then CompareNaturalNum = 1 Exit Function Else If (Mid(string1, iPos1, 1) &lt; Mid(string2, iPos2, 1)) Then CompareNaturalNum = -1 Exit Function ElseIf (Mid(string1, iPos1, 1) &gt; Mid(string2, iPos2, 1)) Then CompareNaturalNum = 1 Exit Function End If iPos1 = iPos1 + 1 iPos2 = iPos2 + 1 End If Loop ' Everything was the same so far, check if Len(string2) &gt; Len(String1) ' If so, then string1 &lt; string2 If Len(string2) &gt; Len(string1) Then CompareNaturalNum = -1 Exit Function End If Else If IsNull(string1) And Not IsNull(string2) Then CompareNaturalNum = -1 Exit Function ElseIf IsNull(string1) And IsNull(string2) Then CompareNaturalNum = 0 Exit Function ElseIf Not IsNull(string1) And IsNull(string2) Then CompareNaturalNum = 1 Exit Function End If End If End Function </code></pre> <p><strong>isDigit(Used in CompareNaturalNum)</strong></p> <pre><code>Function isDigit(ByVal str As String, pos As Integer) As Boolean Dim iCode As Integer If pos &lt;= Len(str) Then iCode = Asc(Mid(str, pos, 1)) If iCode &gt;= 48 And iCode &lt;= 57 Then isDigit = True End If End Function </code></pre>
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload