假设我有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 | ...... | ........
^^如您所见，列中有空行，其中名称未显示在列表中。
下面的代码应该做你想要的。请试一试。请注意，您可以在代码顶部的枚举中设置主要参数。
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，NwsSortClm1）.Value）和_ Len（.Cells（R，NwsSortClm2）.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，代码的一个循环将一直运行，直到再次点击断点。而不是按F5，您可以按F8只运行一行代码并停止。
在循环中，将首先执行Debug.Print指令。您可以将光标指向Rand，当前行号将显示在光标旁边。 Debug.Print指令将打印两个SortColumns的当前值和这些字符串的长度（字符数）到立即窗口（在代码窗口面板下面）。代码继续循环，而两个单元格的长度都大于零。如果由于逻辑错误，这种情况永远不会发生，那么循环将无限期地继续，这不是意图。
要停止测试，请移除断点并按F5或按顶部命令栏中“运行”命令上方的小方块，其中“重置”作为控制提示文本。