|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 一指禅62 于 2019-12-11 09:38 编辑
- Sub 证书号最后更新时间()
- Dim arr, i&, a(), m&, n&, S$, d As Object
- arr = Sheet1.Range("A1").CurrentRegion
- Set d = CreateObject("Scripting.Dictionary")
- For i = 2 To UBound(arr)
- S = arr(i, 4)
- If Not d.Exists(S) Then
- n = n + 1: ReDim Preserve a(1 To 5, 1 To n)
- a(1, n) = arr(i, 1)
- a(2, n) = arr(i, 2)
- a(3, n) = arr(i, 3)
- a(4, n) = "'" & arr(i, 4)
- a(5, n) = arr(i, 5)
- d(arr(i, 4)) = n
- Else
- m = d.Item(S)
- If a(5, m) < arr(i, 5) Then
- a(2, m) = arr(i, 2)
- a(3, m) = arr(i, 3)
- a(5, m) = arr(i, 5)
- End If
- End If
- Next
- Sheet2.Range("A2:E65536").ClearContents
- Sheet2.Range("A2").Resize(n, 5) = WorksheetFunction.Transpose(a)
- End Sub
复制代码
|
|