Question

比方说，我有Column A，其名称后面跟着Column B和Column C中的一些数据

类似地，我有Column D，其名称后面跟着Column E和Column F中的一些数据。

我想按字母顺序对行进行排序，并保留某些列（在本例中为A和D）作为其字母指南。

稍后，如果我添加更多具有更多名称和数据的列，我希望函数/公式也将添加到列表中。

例如：

    A    |    B    |    C    |    D    |    E    |    F
---------+---------+---------+---------+---------+---------
 Albert  | ....... | ....... | Albert  | ....... | .......
 Charlie | ....... | ....... | Brian   | ....... | .......
         |         |         | David   | ....... | .......

预期结果：

阿尔伯特将在同一行显示与在A和D列中重复显示的情况相同的行。 Brian，Charlie和David会在不同的行中显示，因为它们的名称不会在各列中重复。

有办法吗？

    A    |    B    |    C    |    D    |    E    |    F
---------+---------+---------+---------+---------+---------
 Albert  | ....... | ....... | Albert  | ....... | .......
         |         |         | Brian   | ....... | .......
 Charlie | ......  |......   |         |         |  
         |         |         | David   | ......  | ........

^^如您所见，列中有空白行，但列表中未显示名称。

Answer 1

下面的代码应做您想要的。请尝试一下。请注意，您可以在代码顶部的枚举中设置主要参数。

Option Explicit

Enum Nws                            ' Worksheet navigation: modify as appropriate
    ' 03 Mar 2019
    NwsFirstDataRow = 2             ' assuming 1 caption row: change as appropriate
    NwsSortClm1 = 1                 ' First name column to sort (1 = A)
    NwsSortClm2 = 4                 ' 4 = D
    NwsDataClms = 2                 ' number of data columns next to sort columns
End Enum

Sub SortNames()
    ' 03 Mar 2019

    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim Rng As Range
    Dim Arr(1) As Variant
    Dim R As Long, C As Long
    Dim i As Long
    Dim p As Long                           ' priority

    Application.ScreenUpdating = False
    Set Wb = ThisWorkbook                   ' change as appropriate: better to define Wb by name
    Set Ws = Worksheets("Sheet1")           ' change tab name as appropriate
    Ws.Copy After:=Ws
    Set Ws = ActiveSheet

    C = NwsSortClm1
    For i = 0 To 1                          ' corresponds to LBound(Arr) To UBound(Arr)
        With Ws
            Set Rng = .Range(.Cells(NwsFirstDataRow, C), _
                             .Cells(.Rows.Count, C + NwsDataClms).End(xlUp))
            With .Sort.SortFields
                .Clear
                .Add Key:=Rng.Columns(1), _
                     SortOn:=xlSortOnValues, _
                     Order:=xlAscending, _
                     DataOption:=xlSortNormal
            End With
            With .Sort
                .SetRange Rng
                .Header = False
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With

            Arr(i) = .Range(.Cells(NwsFirstDataRow, C), _
                             .Cells(.Rows.Count, C + NwsDataClms).End(xlUp)).Value
        End With
        C = NwsSortClm2
    Next i

    R = NwsFirstDataRow
    With Ws
        Do While Len(.Cells(R, NwsSortClm1).Value) And _
                 Len(.Cells(R, NwsSortClm2).Value) > 0
            p = StrComp(.Cells(R, NwsSortClm1).Value, _
                        .Cells(R, NwsSortClm2).Value, _
                        vbTextCompare)          ' not case sensitive !
            If p Then
                C = IIf(p < 0, NwsSortClm2, NwsSortClm1)
                Set Rng = .Range(.Cells(R, C), .Cells(R, C + NwsDataClms))
                Rng.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
            R = R + 1
        Loop
    End With
    Application.ScreenUpdating = True
End Sub

该代码应安装在标准代码模块中。运行的过程称为 SortNames 。

出于测试目的，请创建您的实际数据的简短版本，例如仅5至8行。创建此测试表的至少3个版本。一个具有两个相等长度的SortColumns，每个具有一个SortColumns较长的地方。观察到一个SortColumn在另一SortColumn完成之后是否在末尾有多个条目应该有所不同。请记住在测试运行之前更改Set Ws = Worksheets("Sheet1")中的标签名称。

在双行 Do While Len（.Cells（R，NwsSortRTI1）.Value）和_下添加此代码 Len（.Cells（R，NwsSortRTI2）.Value）> 0

Debug.Print .Cells(R, NwsSortClm1).Value, Len(.Cells(R, NwsSortClm1).Value), _
                    .Cells(R, NwsSortClm2).Value, Len(.Cells(R, NwsSortClm2).Value)

并向其添加一个断点。要添加断点，请单击代码窗口左侧的灰色垂直栏。此处将出现两个棕色点，两行将突出显示为棕色。（要删除断点，请单击棕色点。）现在，将光标放在过程 SortNames 中的任意位置并按F5键，代码将运行到断点并停止。停止后，所有值都会存储在内存中，您可以查询它们以确保它们符合预期。

测试的第一部分是在断点以上运行代码。它创建工作表的副本并对两列进行排序。您将能够看到进度。到目前为止，如果有任何不正常之处，则必须对代码的前半部分进行更多测试。如果不是，请再次按F5。每次按F5键，都会运行一个代码循环，直到再次击中断点为止。您可以按F8键只运行一行代码并停止，而不必按F5键。

在循环中，Debug.Print指令将首先执行。您可以将光标指向R，当前行号将显示在光标旁边。 Debug.Print指令会将两个SortColumns的当前值以及这些字符串的长度（字符数）打印到立即窗口（在代码窗口面板下面）。当两个像元的长度均大于零时，代码将继续循环。如果由于逻辑错误而从未发生这种情况，则循环将无限期地继续下去，而不是本意。

要停止测试，请删除断点并按F5或按顶部命令栏中 Run 命令上方的小方块，该命令栏中带有“重置”作为控制提示文本。

如何在MS Excel中跨列按字母顺序对行进行排序？

1 个答案: