- 「方法2」：工作表排序+字典，查询最近时间手机号|完整代码
1、在工作表“Sheet1”里，命令按钮点击事件，调用queryAll查询过程：Private Sub CmdQueryAll_Click() Call queryAllEnd Sub 2、在myModule模块里，queryAll过程，查询数据：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第二部分，把字典数据展开到数组temp，再写入目标工作表： 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 3、在myModule模块里，工作表Range排序过程：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
|
