|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub test()
- Dim arr, d, i, brr(), s
- Set d = CreateObject("scripting.dictionary") '创建字典
- arr = Sheets("第一个问题").Range("a1").CurrentRegion '将表1中A1起的连续单元格区域载入数组arr
- For i = 1 To UBound(arr)
- d(arr(i, 2)) = arr(i, 1)
- Next
- For i = 1 To UBound(arr)
- s = Val(Right(Val(Cells(i, 3)), 6))
- k = k + 1
- ReDim Preserve brr(1 To k)
- If d.exists(s) Then
- brr(k) = d(s)
- End If
- Next
- Sheets("第一个问题").Range("d1:d10000").ClearContents
- Sheets("第一个问题").Range("d1").Resize(UBound(brr)) = Application.WorksheetFunction.Transpose(brr)
- Set d = Nothing
- End Sub
复制代码 |
|