按照条件由1表生成2表

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, br, vResult, i&, j&, p&, m&, n&
   
    Application.ScreenUpdating = False
   
    With Worksheets(1).[A1].CurrentRegion
        ar = .Resize(.Rows.Count + 1)
        ReDim vResult(1 To UBound(ar), 1 To 6)
        br = Split("序号 姓名 班级 组合2 名次 4选2总分")
        For j = 0 To UBound(br)
            vResult(1, j + 1) = br(j)
        Next j
    End With
    For i = 2 To UBound(ar) - 1
        vResult(i, 2) = ar(i, 2)
        vResult(i, 3) = ar(i, 3)
        For j = 9 To 12
            If Len(ar(i, j)) Then
                vResult(i, 4) = vResult(i, 4) & Mid(ar(1, j), 1, 1)
                vResult(i, 6) = vResult(i, 6) + ar(i, j)
            End If
        Next j
    Next i
   
    bSort vResult, 2, UBound(vResult) - 1, 1, UBound(vResult, 2), 4
    p = 2
    For i = 2 To UBound(vResult) - 1
        If vResult(i + 1, 4) <> vResult(p, 4) Then
            bSort vResult, p, i, 1, UBound(vResult, 2), 6, False
            n = 0
            For j = p To i
                m = m + 1
                vResult(j, 1) = m
                n = n + 1
                vResult(j, 5) = n
            Next j
            p = i + 1
        End If
    Next i
   
    Cells.Clear
    With [A1].Resize(UBound(vResult) - 1, UBound(vResult, 2))
        .Value = vResult
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
        .Rows(1).Font.Bold = True
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With
   
    Application.ScreenUpdating = True
    Beep
End Sub
Function bSort(ar, iFirst&, iLast&, iLeft&, iRight&, _
    iKey&, Optional isOrder As Boolean = True)
    Dim i&, j&, k&, vTemp
    For i = iFirst To iLast - 1
        For j = iFirst To iLast + iFirst - 1 - i
            If ar(j, iKey) <> ar(j + 1, iKey) Then
                If ar(j, iKey) < ar(j + 1, iKey) Xor isOrder Then
                    For k = iLeft To iRight
                        vTemp = ar(j, k): ar(j, k) = ar(j + 1, k): ar(j + 1, k) = vTemp
                    Next
                End If
            End If
        Next j
    Next i
End Function

gwjkkkkk

参与一下。。。