Question

我目前有一个包含超过2000行数据的Excel电子表格。在其中一列中，我有一个ID，该ID是包含多个小数点的字符串。我需要根据此ID对Excel电子表格中的数据进行排序。 ID的列如下：

1.01.1.3.1
1.01.1.5.2
1.01.1.3.13
1.01.1.3.2
1.02.5.1.1.1.1
1.01.1.3.1.1
1.01.1.3.2.1

结果应如下所示：

1.01.1.3.1
1.01.1.3.1.1
1.01.1.3.2
1.01.1.3.2.1
1.01.1.3.13
1.01.1.5.2
1.02.5.1.1.1.1

我正在使用VBA从电子表格中提取数据并存储在数组中，但是我不确定如何从左到右对字符串进行排序。我知道我必须用“。”分隔每个条目。并排序第一个索引，然后是下一个索引，但是我担心这种方法在2000多个条目中会花费太长时间。我还不确定与具有9个索引（例如：1.01.1.1.2.5.1.1.1）的条目相比，如何处理具有5个索引（例如：1.01.1.1.1）的条目

另一个问题是某些条目包含字母。例如：1.01.1.4.1A

注意，我有这个BubbleSort函数：

Public Function BubbleSort(ByVal tempArray As Variant) As Variant
Dim Temp As Variant
Dim i As Integer
Dim NoExchanges As Integer

    ' Loop until no more "exchanges" are made.
    Do
        NoExchanges = True

        ' Loop through each element in the array.
        For i = 0 To UBound(tempArray) - 1

            ' Substitution when element is greater than the element following int
            If tempArray(i) > tempArray(i + 1) Then
                NoExchanges = False
                Temp = tempArray(i)
                tempArray(i) = tempArray(i + 1)
                tempArray(i + 1) = Temp
            End If

        Next i

    Loop While Not (NoExchanges)

    BubbleSort = tempArray

End Function

如果任何人对解决方案有任何见识，我们将不胜感激。

Answer 1

我从“排序”例程库中获取了以下内容。请忽略我的一些命名约定：)。

经审查，我注意到我的CompareNaturalNum()例程存在一个问题，它认为 “ 1.01.1.3.1”和“ 1.01.1.3.1.1”相同。我已经在以下代码中修复了它，并展示了如何使用它。

QuickSortMultiNaturalNum -对变体数组的快速排序，您可以在其中指定要排序的列。

Public Sub QuickSortMultiNaturalNum(strArray As Variant, intBottom As Long, intTop As Long, intSortIndex As Long, Optional intLowIndex As Long, Optional intHighIndex As Long = -1)
Dim strPivot As String, strTemp As String
Dim intBottomTemp As Long, intTopTemp As Long
Dim i As Long

intBottomTemp = intBottom
intTopTemp = intTop

If intHighIndex < intLowIndex Then
    If (intBottomTemp <= intTopTemp) Then
        intLowIndex = LBound(strArray, 2)
        intHighIndex = UBound(strArray, 2)
    End If
End If

strPivot = strArray((intBottom + intTop) \ 2, intSortIndex)

While (intBottomTemp <= intTopTemp)

' < comparison of the values is a descending sort
While (CompareNaturalNum(strArray(intBottomTemp, intSortIndex), strPivot) < 0 And intBottomTemp < intTop)
    intBottomTemp = intBottomTemp + 1
Wend

While (CompareNaturalNum(strPivot, strArray(intTopTemp, intSortIndex)) < 0 And intTopTemp > intBottom)
    intTopTemp = intTopTemp - 1
Wend

If intBottomTemp < intTopTemp Then
    For i = intLowIndex To intHighIndex
        strTemp = Var2Str(strArray(intBottomTemp, i))
        strArray(intBottomTemp, i) = Var2Str(strArray(intTopTemp, i))
        strArray(intTopTemp, i) = strTemp
    Next
End If

If intBottomTemp <= intTopTemp Then
    intBottomTemp = intBottomTemp + 1
    intTopTemp = intTopTemp - 1
End If

Wend

'the function calls itself until everything is in good order
If (intBottom < intTopTemp) Then QuickSortMultiNaturalNum strArray, intBottom, intTopTemp, intSortIndex, intLowIndex, intHighIndex
If (intBottomTemp < intTop) Then QuickSortMultiNaturalNum strArray, intBottomTemp, intTop, intSortIndex, intLowIndex, intHighIndex
End Sub

CompareNaturalNum -自定义比较功能

Function CompareNaturalNum(string1 As Variant, string2 As Variant) As Long
'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 Long, iPosOrig2 As Long
Dim iPos1 As Long, iPos2 As Long
Dim nOffset1 As Long, nOffset2 As Long

    If Not (IsNull(string1) Or IsNull(string2)) Then
        iPos1 = 1
        iPos2 = 1
        Do While iPos1 <= Len(string1)
            If iPos2 > 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 < n2) Then
                    CompareNaturalNum = -1
                    Exit Function
                ElseIf (n1 > n2) Then
                    CompareNaturalNum = 1
                    Exit Function
                End If

                ' front padded zeros (put 01 before 1)
                If (n1 = n2) Then
                    If (nOffset1 > nOffset2) Then
                        CompareNaturalNum = -1
                        Exit Function
                    ElseIf (nOffset1 < 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) < Mid(string2, iPos2, 1)) Then
                    CompareNaturalNum = -1
                    Exit Function
                ElseIf (Mid(string1, iPos1, 1) > 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) > Len(String1)
        ' If so, then string1 < string2
        If Len(string2) > 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

isDigit -简单的函数，可让您知道字符串值是否为数字（0-9）

Function isDigit(ByVal str As String, pos As Long) As Boolean
Dim iCode As Long
    If pos <= Len(str) Then
        iCode = Asc(Mid(str, pos, 1))
        If iCode >= 48 And iCode <= 57 Then isDigit = True
    End If
End Function

Var2Str -由于它处理Variants，因此其值可能为Null，因此请将其转换为字符串

Public Function Var2Str(Value As Variant, Optional TrimSpaces As Boolean = True) As String
    If IsNull(Value) Then
        'Var2Str = vbNullString
        Exit Function
    End If
    If TrimSpaces Then
        Var2Str = Trim(Value)
    Else
        Var2Str = CStr(Value)
    End If
End Function

测试-这是如何使用它的示例代码。只需更改范围值。调用1的最后一个QuickSortMultiNaturalNum是要排序的列（ID所在的列）。

Sub Test()
Dim Target As Range
Dim vData 'as Variant
Dim Rows As Long
    ' Set Target to the CurrentRegion of cells around "A1"
    Set Target = Range("A1").CurrentRegion
    ' Copy the values to a variant
    vData = Target.Value2
    ' Get the high/upper limit of the array
    Rows = Target.Rows.Count    'UBound(vData, 1)
    ' Sor The variant array, passing the variant, lower limit, upper limit and the index of the column to be sorted.
    QuickSortMultiNaturalNum vData, 1, Rows, 1
    ' Paste the values back onto the sheet.  For testing, you may want to paste it to another sheet/range
    Range("A1").Resize(Target.Rows.Count, Target.Columns.Count).Value = vData
End Sub

Answer 2

如果允许您使用其他列，请执行以下操作：

将ID列复制到新列
检查每个单元格中的最大点数
从每个单元格中删除每个非数字[^ 0-9]和非点[^。]
修改每个单元格，包括最大点数，如下所示：

发件人：

1.01.1.3.13

收件人：

1.01.01.03.13.00

例如如果它仅由1个值组成，则添加一个零并添加其他点，以等于带有点的最大值。
在新列中删除点
按新列排序
删除新列
就这样！

如果不允许使用其他列，则应使用一些映射技术。

Answer 3

此代码使用.分隔符来划分范围。
然后，在基于拆分进行排序之前，它会向拆分中的空白单元格添加0，还包括原始文本。
然后清除拆分的单元格，仅保留排序后的原始值。
1.01.1.4.1A出现在1.01.1.3.13和1.01.1.5.2之间。

Sub Test()

    Dim wrkSht As Worksheet
    Dim rng As Range
    Dim rng_Split As Range
    'Dim rng_Blanks As Range - EDIT: Not needed.
    Dim lLastCol As Long
    Dim rCol As Range

    Set wrkSht = ThisWorkbook.Worksheets("Sheet1")

    'Split the value and find the last column it splits to.
    With wrkSht
        'Adjust the range to yours.
        Set rng = .Range("A31:A38")

        rng.TextToColumns _
            Destination:=rng.Offset(, 1), _
            DataType:=xlDelimited, _
            Other:=True, _
            OtherChar:="."

        lLastCol = rng.EntireRow.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    End With

    'Add a 0 to all blank cells.
    Set rng_Split = rng.Offset(, 1).Resize(rng.Rows.Count, lLastCol - 1)
    rng_Split.SpecialCells(xlCellTypeBlanks).Value = 0

    With wrkSht
        With .Sort
            .SortFields.Clear
            For Each rCol In rng_Split.Columns
                .SortFields.Add Key:=rCol, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            Next rCol
            'Adjust this range to include all columns to be sorted.
            .SetRange rng_Split.Offset(, -1).Resize(, lLastCol)
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .Apply
        End With
    End With

    rng_Split.ClearContents

End Sub

编辑：使用此方法01和1被认为是相同的。

如何在VBA中对具有多个小数位的数字字符串进行排序

3 个答案: