文章背景：在数据处理时，有时需要根据指定列的内容进行重新排序。比如样品测试时，假设存在5个测试点，其中2号点和3号点无需测，在做报告时，一般会保留2号点和3号点的位置，测试数据为空。
针对排序的步骤，可以通过VBA代码实现。之前提到过一种方法，参见文末的延伸阅读。当数据条不多时，该方法的运行时长还可以接受。当数据条有上百条时，运行速度相对较慢。下面介绍另一种排序的方法。
代码实现：在原有测试数据的基础上，根据“品号”列和给定的测试点数目（暂定91个），进行重新排序。
代码语言：javascript复制Option Explicit
Sub sample_sort2()
'根据品号列重新排序
Dim row_ini As Integer, row_test As Integer, number As Integer
Dim name_sample As String, ii As Integer
Dim row_temp As Integer, row_object As Integer, obj_range As Range
Dim time_ini As Date '用于计时
time_ini = Timer '计时开始
row_ini = 2 '测试数据从第2行开始 (第1行是标题行)
row_test = Cells(Rows.Count, 3).End(xlUp).Row '测试数据最后一行的行号
number = 91 '测试点数目，包括无需测的测试点。
name_sample = "SAM21-123" '样品名称
'1. 根据“品号”列查找测试数据
For ii = 1 To number
row_temp = row_test 1 ii
Cells(row_temp, 3) = "SAM21-123" & "-" & CStr(ii) '输入样品单号
With Columns(3)
Set obj_range = .Find(What:=Cells(row_temp, 3), After:=Cells(1, 3), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False)
If Not obj_range Is Nothing Then
row_object = obj_range.Row
If row_object <= row_test Then
'复制目标行到指定区域
Rows(row_object).Copy
Rows(row_temp).Select
ActiveSheet.Paste
End If
End If
End With
Next ii
'2. 覆盖原有的测试数据
Rows(row_test 2 & ":" & row_test 2 number row_test - row_ini 1).Copy
Rows(row_ini).Select
ActiveSheet.Paste
MsgBox "Done! " & vbCrLf & vbCrLf & "用时：" & Format(Timer - time_ini, "0.0s")
Exit Sub
End Sub运行效果：http://mpvideo.qpic.cn/0b2exqaagaaar4amro7gxnqvbpgdao6aaaya.f10002.mp4?dis_k=dcbfff7855cb999bf6da58411cd129e4&dis_t=1663656253&vid=wxv_2230077549173440516&format_id=10002&support_redirect=0&mmversion=false
延伸阅读：
[1] VBA: 单元格区域基于指定列重新排序
