【代码2】数据查询「方法2」：工作表排序+字典，查询最近时间手机号

Sub queryAll()    Dim ws As Worksheet, iRow As Integer, iCol As Integer, lastRow As Integer    Dim arrOriginal(), arr(), temp(), rng As Range    Dim dic As Object    Dim phone, plate    Set ws = ThisWorkbook.Sheets("Sheet1")    Set dic = CreateObject("Scripting.Dictionary")    With ws        lastRow = .UsedRange.Rows.Count        Set rng = .Range(.Cells(1, 1), .Cells(lastRow, 4))                '//保存原始数据，待回写（如果原始数据有公式，这个方法就不太适合）        arrOriginal = rng.Value                '//工作表按车牌号升序、按时间降序排序        '//如果原始数据有公式等情况下，可以新建一张临时工作表，把数据复制过去进行排序        '//数据读取完成后，再删除临时工作表        Call SortRange(rng, .Columns(4), Columns(2), True, xlDescending)                '//排序后的数据存入数组arr        arr = rng.Value                '//把保存的原始数据回写到rng,恢复原状        rng.Value = arrOriginal            End With        For i = 2 To UBound(arr)        plate = arr(i, 4)        If plate <> "" Then            phone = arr(i, 3)            If Not dic.exists(plate) Then                                '//由于工作表已经排序，只需要添加首次循环到的车牌号                Set dic(plate) = CreateObject("Scripting.Dictionary")                                '//跳过空手机号                If phone <> "" Then                    dic(plate)(phone) = ""                End If            Else                If phone <> "" Then                                        '//如果手机号不为空，则对已存在的手机号重新赋值（相当于已存在则跳过，省掉一个是否存在的判断）                    '//如果是新的手机号，则顺序加入字典。                    dic(plate)(phone) = ""                End If                            End If                    End If    Next

    iRow = dic.Count    ReDim temp(1 To iRow, 1 To 1)    k = 0    For Each plate In dic.keys        k = k + 1        temp(k, 1) = plate        iCol = dic(plate).Count + 1        If iCol > 1 Then                        '//当前车牌号的所有手机号            phone = dic(plate).keys            If UBound(temp, 2) < iCol Then                                '//如果手机号数量+1，超过了temp的列数，则扩展temp的列                ReDim Preserve temp(1 To iRow, 1 To iCol)            End If                        '//把当前车牌的手机号，依次写入temp的当前行            For i = 0 To iCol - 2                temp(k, i + 2) = phone(i)            Next        End If    Next        With ws        If .UsedRange.Rows.Count > 1 Then            .Range(.Cells(2, 12), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Clear        End If                '//如果只需要一个最新的手机号，把UBound(temp, 2)改为2'        Set rng = .Cells(2, 12).Resize(iRow, 2)        Set rng = .Cells(2, 12).Resize(iRow, UBound(temp, 2))        rng.Value = temp        rng.Borders.LineStyle = 1    End With    MsgBox "查询完成!"End Sub

Sub SortRange(rng As Range, _        primarySortKey As Range, _        secondarySortKey As Range, _        Optional includeTitle As Boolean = True, _        Optional sortOrder As XlSortOrder = xlAscending)    If includeTitle Then        rng.Sort Key1:=primarySortKey, Order1:=xlAscending, _            Key2:=secondarySortKey, Order2:=sortOrder, _            Header:=xlYes, OrderCustom:=1, MatchCase:=False, _            Orientation:=xlTopToBottom    Else        rng.Sort Key1:=primarySortKey, Order1:=xlAscending, _            Key2:=secondarySortKey, Order2:=sortOrder, _            Header:=xlNo, OrderCustom:=1, MatchCase:=False, _            Orientation:=xlTopToBottom    End IfEnd Sub