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