Excel对具有不同标题的一列进行排序

Question

为简单起见，假设有A列：

John
23
9
12
33
Peter
42
23
44
5
9
Mark
4
6
87

如何在3个不同的列中对其进行排序，其中名称出现在每一列的顶部，相应的数据出现在每个名称的下面？

Answer 1

我敢肯定，您只想将一列拆分为几列，但这还包括用于对每一列进行排序的代码。

Option Explicit

Sub test()

    Dim i As Long, a As Long, rws As Long, rng As Range

    With Worksheets("sheet3")

        rws = .Cells(.Rows.Count, "A").End(xlUp).Row

        'split into columns based on a text header value
        For i = 1 To .Columns("A").SpecialCells(xlCellTypeConstants, xlTextValues).Cells.Count - 1
            Set rng = .Range(.Cells(2, i), .Cells(.Rows.Count, i).End(xlUp))
            a = Application.Match("*", rng, 0)
            With .Cells(a + 1, i).Resize(rws, 1)
                .Parent.Cells(1, i + 1).Resize(.Rows.Count, 1) = .Value
                .Clear
            End With
        Next i

        'did you actually want to sort the split values?
        For i = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
            With .Range(.Cells(1, i), .Cells(.Rows.Count, i).End(xlUp))
                .Sort key1:=.Cells(1), order1:=xlAscending, Header:=xlYes
            End With
        Next i

    End With

End Sub

Answer 2

页眉到列

• 调整常量（Const）部分中的值以适合您的 需求。
• 当前设置的结果如下图所示：

代码

Sub HeaderColumnToColumns()

    Const cSource As Variant = "Sheet1"   ' Source Worksheet Name/Index
    Const cSrcCol As Variant = "A"        ' Source Column Letter/Number
    Const cSrcFR As Long = 1              ' Source First Row Number

    Const cTarget As Variant = "Sheet1"   ' Target Worksheet Name/Index
    Const cTgtCol As Variant = "B"        ' Target Column Letter/Number
    Const cTgtFR As Long = 1              ' Target First Row Number

    Dim rng As Range      ' Target Range.
    Dim vntS As Variant   ' Source Array
    Dim vntT As Variant   ' Target Array
    Dim srcLR As Long     ' Source Last Row Number
    Dim srcRC As Long     ' Source Rows Count
    Dim tgtRC As Long     ' Target Rows Count
    Dim tgtCC As Long     ' Target Columns Count
    Dim i As Long         ' Source Row Counter
    Dim j As Long         ' Target Column Counter
    Dim k As Long         ' Target Row Counter

    ' In Source Column
    With ThisWorkbook.Worksheets(cSource).Columns(cSrcCol)
        ' Calculate Source Last Row Number.
        srcLR = .Cells(.Rows.Count).End(xlUp).Row
        ' Calculate Source Column Range.
        ' Copy Source Column Range to Source Array
        vntS = .Cells(cSrcFR, cSrcCol).Resize(srcLR - cSrcFR + 1)
    End With

    ' Write number of rows in Source Array to Source Rows Count.
    srcRC = UBound(vntS)

'    ' Reset Target Column Counter to 0 (because j = j + 1).
'    j = 0
    ' Reset Target Row Counter to 1 because of headers (titles).
    k = 1

    ' Calculate Number of Target Rows (tgtRC) and Columns (tgtCC) Count.
    ' Loop through rows of one-column Source Array.
    For i = 1 To srcRC
        ' Check if current value in Source Array is not an empty string.
        If vntS(i, 1) <> "" Then
            ' Check if current value in Source Array is a number.
            If IsNumeric(vntS(i, 1)) Then
                ' Count current row in Target Array (Next Row).
                k = k + 1
              Else
                ' Count Target Array Columns Count (Next Column).
                tgtCC = tgtCC + 1
                ' Check if current row in Target Array is greater than Target
                ' Array Rows Count. If so, write current row in Target Array
                ' to Target Array Rows Count.
                If k > tgtRC Then tgtRC = k
                ' Reset Target Row Counter to 1 because of headers (titles).
                k = 1
            End If
        End If
    Next

    ' Resize Target Array to just counted rows and columns.
    ReDim vntT(1 To tgtRC, 1 To tgtCC)

    ' Reset Target Column Counter to 0 (because j = j + 1).
    j = 0
    ' Reset Target Row Counter to 1 (because of headers (titles)).
    k = 1
    ' Loop through rows of one-column Source Array.
    For i = 1 To srcRC
        ' Check if current value in Source Array is not an empty string.
        If vntS(i, 1) <> "" Then
            ' Check if current value in Source Array is a number.
            If IsNumeric(vntS(i, 1)) Then
                ' Count current row in Target Array.
                k = k + 1
              Else
                ' Count current column in Target Array (Next Column).
                j = j + 1
                ' Reset Target Row Counter to 1 because of headers (titles).
                k = 1
            End If
            ' Write current value of current element in Source Array to current
            ' element in Target Array.
            vntT(k, j) = vntS(i, 1)
        End If
    Next

    ' In Target Columns
    With ThisWorkbook.Worksheets(cTarget).Columns(cTgtCol).Resize(, tgtCC)
        ' Calculate Target Columns Range.
        ' Note: Target Columns Range is the range in Target Columns that spans
        '       from the cells in Target First Row to the bottom row.
        ' Clear contents of Target Column Range.
        .Cells(cTgtFR, 1).Resize(.Rows.Count - cTgtFR + 1, tgtCC).ClearContents
        ' Note: Target Range is the cell range at the intersection of Target
        '       First Row and Target Column resized by the size of Target Array,
        '       i.e. rows (tgtRC) and columns (tgtCC) of Target Array.
        ' Calculate Target Range.
        Set rng = .Cells(cTgtFR, 1).Resize(tgtRC, tgtCC)
        ' Copy Target Range to Source Array
        rng = vntT

        ' Apply formatting to Target Range.
        With rng
            .Columns.AutoFit
            .Font.Bold = True
            .BorderAround , , 1
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous ' Required.
                '.Weight = xlThin
                .ColorIndex = 1
            End With
            With .Rows(1)
                .Interior.ColorIndex = 49
                .Font.ColorIndex = 2
                .BorderAround , , 1
            End With
        End With
        ' ColorIndex:   1-Black, 2-White 3-Red, 4-(Bright) Green, 5-Blue,
        '               6-Yellow, 7-Pink, 8-Turquoise, 9 - Dark Red, 10 - Green

    End With

End Sub