楼主
liuguansky |
Q：如何依多表多栏次内容，在提取表中返回相对应栏目？
A：可用如下代码实现：
- Sub justtest()
- Dim arr, i%, m&, n&, k1&, k2&, s&, k&, t&, dic, arrs, arrt() As String, g
- Set dic = CreateObject("scripting.dictionary")
- g = Timer
- Application.ScreenUpdating = False
- For i = 1 To 3
- With Sheets(i)
- k1 = .Cells(.Rows.Count, "u").End(3).Row
- k2 = .Cells(1, .Columns.Count).End(1).Column
- s = (k2 - 14) / 35 * 2 + 1
- arr = .Range(.Cells(1, "u"), .Cells(k1, k2)).Value
- End With
- For m = 1 To UBound(arr, 2) Step 35
- For n = 2 To UBound(arr, 1) Step 2
- dic(arr(n, m)) = n
- Next n
- t = (m - 1) / 35 * 2 + 1
- arrs = Range(Cells(5, k + t), Cells(Rows.Count, k + t).End(3)).Value
- ReDim arrt(1 To UBound(arrs, 1), 1 To 1)
- For n = 1 To UBound(arrs, 1)
- If dic.exists(arrs(n, 1)) Then
- arrt(n, 1) = arr(dic(arrs(n, 1)), m + 32)
- End If
- Next n
- Range(Cells(5, k + t + 1), Cells(Rows.Count, k + t + 1)).ClearContents
- Cells(5, k + t + 1).Resize(n - 1, 1) = arrt
- dic.RemoveAll
- Next m
- k = s + k
- Next i
- MsgBox "提取完毕，用时" & Timer - g
- Application.ScreenUpdating = True
- End Sub
速度还行。512内存，速度在0.5秒左右
具体示例文件如下：
|