[已解决]用代码提取数据的问题

Baibdu · 发表于 2014-11-26 09:13

本帖最后由 Baibdu 于 2014-11-26 10:20 编辑

附件

用代码依条件提取数据.rar (7.68 KB, 下载次数: 4)

dsmch · 发表于 2014-11-26 09:39

Sub Macro1()
Dim arr, brr(1 To 60000, 1 To 1), d, i&, j%, s&
Set d = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion
For i = 1 To UBound(arr) - 1
If Not d.exists(arr(i, 1)) Then d(arr(i, 1)) = i Else d(arr(i, 1)) = d(arr(i, 1)) & "," & i
Next
a = d.keys: b = d.items
For i = 0 To d.Count - 1
x = Split(b(i), ",")
If UBound(x) >= 2 Then
For j = 0 To UBound(x)
brr(s + 1, 1) = a(i)
brr(s + 2, 1) = arr(x(j) + 1, 1)
s = s + 3
Next
End If
Next
Range("d1").Resize(s) = brr
End Sub

复制代码

dsmch · 发表于 2014-11-26 09:43

………………

		自动登录	找回密码
密码			注册