Excel快速排序并组合多字段

在excel表中,如果两个字段是字符串型,可以简单用excel函数:字符串拼接符“&”来拼接。
但是,有很多时候,不仅仅需要连接两个字符,还要对两个字符进行排列。
比如说,某个学校的网球队代表学校打了30场比赛,其中双打比赛的出场阵容如下:

现在教练想知道,组成双打的阵容一共有多少种,每种阵容出现过多少次?
问题在于,双打a与双打b的搭配、双打b与双打a的搭配本质上是同一种阵容。
这就需要不仅仅拼接双打a和b的字符串,还要在拼接的时候先对两个字符串排个序

字符的ascii码排序

在VBA中可以用 Asc(char) 来查看某一个字符的ascii码,知道了ascii码就可以进行排序。具体排序的过程可以做成一个函数:

Function compare(strA As String, strB As String)

Dim lA As Long
Dim lB As Long
Dim l As Long
Dim chrA As String
Dim chrB As String
Dim asciiA As Long
Dim asciiB As Long
Dim isBreak As Boolean

'字符串A、字符串B的长度,取最小值作为执行长度
lA = Len(strA)  
lB = Len(strB)
l = Application.WorksheetFunction.Min(lA, lB)

'从1到执行长度,一个个比较字符的ascii码大小,将比较大的字符串输出
isBreak = False
For i = 1 To l

    chrA = Mid(strA, i, 1)
    chrB = Mid(strB, i, 1)
    asciiA = Asc(chrA)
    asciiB = Asc(chrB)
    
    If asciiA > asciiB Then
        compare = strA
        isBreak = True
        Exit For
    Else
        If asciiA < asciiB Then
            compare = strB
            isBreak = True
            Exit For
        End If
    End If
    
Next

'如果两个字符串在l长度内的字符都相等,那么输出较长的哪一个字符串
If isBreak = False Then
    If lA > lB Then
        compare = strB
    Else
        compare = strA
    End If
End If


End Function

做成个人宏,自动生成组合字段

可以做成个人宏
待组合的字段列读取选中方格的列值
代码如下:

Sub 排序组合多字段()

Dim i As Long
Dim j As Long
Dim k As Long

Dim str0 As String
Dim strAll As String

Dim strA As String
Dim strB As String
Dim strTmp As String

Dim nextColumn As Long
Dim thisWs As Worksheet
Set thisWs = ActiveSheet

'判断第一个出现第一行为空的列,这一列将作为输出组合字段的列
For i = 1 To 1000
    If thisWs.Cells(1, i) = "" Then
        nextColumn = i
        Exit For
    End If
Next

'每一秒刷新一次屏幕
Dim t As Single
t = Timer
Application.ScreenUpdating = False

'声明待组合字段的列的数组,最多30列
Dim arrColumn(29) As Long
'声明待组合字段的字符串数组
Dim strOrder(29) As String

Dim rMax As Long
rMax = thisWs.Cells(Rows.Count, 1).End(xlUp).Row

Dim c As Long
c = -1

'对选中的单元格的每一列都记录下来
For Each cl In Selection
    c = c + 1
    a = cl.Column
    arrColumn(c) = a
Next


With thisWs
For i = 2 To rMax

    strAll = ""
    
    '每一列的字符串都读取进来
    For j = 0 To c
        strOrder(j) = .Cells(i, arrColumn(j))
    Next
    
    '排序
    For j = 1 To c
        strA = strOrder(j)
        For k = 0 To j - 1
            strB = strOrder(k)
            If strB = compare(strA, strB) Then
                strTmp = strA
                strOrder(j) = strB
                strOrder(k) = strTmp
                Exit For
            End If
        Next
    Next
    
    '拼接字符串
    For j = 0 To c
          
        str0 = strOrder(j)
        
        If str0 = "" Then
        Else
            strAll = strAll + str0 + ","
            
        End If
        
    Next
    
    If strAll = "" Then
    Else
        strAll = Left(strAll, Len(strAll) - 1)
    End If
    
    .Cells(i, nextColumn) = strAll
    
    .Cells(1, nextColumn) = i & "/" & rMax
    If Timer - t > 1 Then
        Application.ScreenUpdating = True
        t = Timer
        DoEvents
        Application.ScreenUpdating = False
    End If
    
Next
Application.ScreenUpdating = True

.Cells(1, nextColumn) = "组合字段"
End With
        
End Sub

选中我想要排序合并的两列字段的两个单元格,就像这样

然后执行个人宏就可以啦,执行之后的效果就像这样。我还进行了countif,这样每一组搭配共出现过多少次也清清楚楚了。

意想不到的CP:大石与柳前辈 =_=

posted on 2020-09-02 11:22  麦子小偷  阅读(459)  评论(0编辑  收藏  举报

导航