VBA: 单元格区域基于指定列重新排序（2）

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