Excel宏按一列中的字数对数据进行排序，并扩展到其他数据列

Question

我有一个包含11列和超过6000行的数据工作表。我需要将列F按每个单元格中的单词数排序，从最小到最大，将排序扩展到11列中的整个数据。

这可以实现吗？感谢在这件事上的任何帮助。

Answer 1

最简单的解决方案是使用Microsoft support artice kb213889中建议的工作表公式。如果您准备假设分隔符是''并且该列仅包含有效单词，则在行L中您可以添加具有以下公式的排序索引列：

=IF(F1=TRIM(""),-1,LEN(TRIM(F1))-LEN(SUBSTITUTE(TRIM(F1)," ","")))

根据索引列有多种选项可供选择，例如： VBA（例如Steve Bullen's QuickSort()）或使用标准Excel排序功能。

如果你坚持在VBA中进行整个计算，可能的解决方案是将整个数组读入变量并在数组上附加一个加法列，然后再使用上面的QuickSort（）算法对数组进行排序。计算单词数量的简单函数可以是：

'count words in input string - assume only words passed in
Public Function CountWords(vInput As Variant, Optional sDelim As String = " ") As Integer
Dim iWordCount as integer
Dim sString as string


    sString = Trim$(vInput)

    If Len(sString) = 0 Then
        iWordCount = 0
    ElseIf InStr(1, sString, sDelim) = 0 Then
        iWordCount = 1
    Else
         'return array 0 based
         iWordCount = UBound(VBA.Split(sString, sDelim)) + 1
    End If

    CountWords = iWordCount

End 

Answer 2

以下变体基于假设您的数据表在“A：K”范围内（如您所提到的11列）。将“Sheet1”替换为包含数据的工作表名称

Sub sort_by_words_count()
    Dim Cl As Range, S() As String, i&
    Application.ScreenUpdating = 0
    With ThisWorkbook.Worksheets("Sheet1")
        i = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        For Each Cl In .Range("F2:F" & i)
            S = Split(WorksheetFunction.Trim(Cl.Value))
            Cl.Value = Right("0000" & UBound(S()) + 1, 4) & "|" & Cl.Value
        Next Cl
        If .AutoFilterMode Then .AutoFilterMode = False
        .Range("A1:K" & i).AutoFilter
        .AutoFilter.Sort.SortFields.Add _
            Key:=Range("F1:F" & i), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
            With .AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        For Each Cl In .Range("F2:F" & i)
            Cl.Value = Split(Cl.Value, "|")(1)
        Next Cl
    End With
    Application.ScreenUpdating = 1
End Sub

排序前

表单

排序后

表单

Answer 3

假设名称在B列中，此宏将所有单元格包括＆＃34; Jon＆＃34;和＃34;史密斯＆＃34;成阵列。创建另一个数组以显示每个数组元素中有多少个单词。然后调用sort2子以通过wordCountarr

对myArr进行排序

我找到了Sort2 sub HERE，它是由Gary的成员编写的，似乎完美无缺。

Sub create2arr()
Dim myArr() As Variant, name1 As String, name2 As String, firstMarker As Boolean, myArrayCounter As Long, myArray2Counter As Long
Dim splitArr() As String, wordCountArr() As Variant

name1 = "Jon"
name2 = "Smith"
ReDim myArr(1 To 1)
ReDim myArr2(1 To 1)
ReDim wordCountArr(1 To 1)

myArrayCounter = 1
myArray2Counter = 1

For I = 1 To 3
   splitArr = Split(Sheet6.Range("B" & I))
   For J = LBound(splitArr) To UBound(splitArr)
        If splitArr(J) = name1 Or splitArr(J) = name2 Then
                If firstMarker = True Then
                    myArr(myArrayCounter) = Sheet6.Range("B" & I)
                    wordCountArr(myArrayCounter) = UBound(splitArr) + 1
                    myArrayCounter = myArrayCounter + 1
                    ReDim Preserve myArr(1 To myArrayCounter)
                    ReDim Preserve wordCountArr(1 To myArrayCounter)
                    firstMarker = False
                Else
                    firstMarker = True
                End If
        End If
    Next J
Next I

For I = 1 To UBound(myArr)
Debug.Print myArr(I)
Next I

Call sort2(wordCountArr, myArr)

For I = 1 To UBound(myArr)
Debug.Print myArr(I)
Next I


End Sub

Sub sort2(key() As Variant, other() As Variant)
Dim I As Long, J As Long, Low As Long
Dim Hi As Long, Temp As Variant
    Low = LBound(key)
    Hi = UBound(key)

    J = (Hi - Low + 1) \ 2
    Do While J > 0
        For I = Low To Hi - J
          If key(I) > key(I + J) Then
            Temp = key(I)
            key(I) = key(I + J)
            key(I + J) = Temp
            Temp = other(I)
            other(I) = other(I + J)
            other(I + J) = Temp
          End If
        Next I
        For I = Hi - J To Low Step -1
          If key(I) > key(I + J) Then
            Temp = key(I)
            key(I) = key(I + J)
            key(I + J) = Temp
            Temp = other(I)
            other(I) = other(I + J)
            other(I + J) = Temp
          End If
        Next I
        J = J \ 2
    Loop
End Sub