|
本帖最后由 fangniuji 于 2012-12-23 16:19 编辑
- Sub aa()
- Dim Arr, brr, CRR(1 To 100000, 1 To 1), drr(1 To 200000, 1 To 1), i&, j&, K&, x&, d As Object
- Set d = CreateObject("scripting.dictionary")
- K = Range("A" & Rows.Count).End(3).Row
- Arr = Range("A1:A" & K)
- For i = 1 To UBound(Arr)
- If Arr(i, 1) = "%" Then K = i
- If Arr(i, 1) = "M30" Then Exit For
- If i > K Then d(Arr(i, 1)) = ""
- Next
- K = Range("B" & Rows.Count).End(3).Row
- brr = Range("B1:B" & K)
- For i = 1 To UBound(brr)
- If brr(i, 1) = "%" Then K = i
- If Arr(i, 1) = "M30" Then Exit For
- If i > K Then
- If d.exists(brr(i, 1)) Then
- j = j + 1
- CRR(j, 1) = brr(i, 1)
- End If
- End If
- Next
- d.RemoveAll
- For i = 1 To j
- d(CRR(i, 1)) = ""
- Next
- For i = 1 To UBound(Arr)
- If Arr(i, 1) = "T1" Or Arr(i, 1) = "T2" Or Arr(i, 1) = "T3" Or Arr(i, 1) = "M30" Then GoTo 100
- If Not d.exists(Arr(i, 1)) Then
- 100: x = x + 1
- drr(x, 1) = Arr(i, 1)
- End If
- Next
- [D1].Resize(j) = CRR
- [c1].Resize(x) = drr
- End Sub
复制代码 大家帮忙一下,执行代码后,把报错改为提示没有相同数据源,谢谢
- Sub aa()
- Dim Arr, brr, CRR(1 To 100000, 1 To 1), drr(1 To 200000, 1 To 1), i&, j&, K&, x&, d As Object
- Set d = CreateObject("scripting.dictionary")
- K = Range("A" & Rows.Count).End(3).Row
- Arr = Range("A1:A" & K)
- For i = 1 To UBound(Arr)
- If Arr(i, 1) = "%" Then K = i
- If Arr(i, 1) = "M30" Then Exit For
- If i > K Then d(Arr(i, 1)) = ""
- Next
- K = Range("B" & Rows.Count).End(3).Row
- brr = Range("B1:B" & K)
- For i = 1 To UBound(brr)
- If brr(i, 1) = "%" Then K = i
- If Arr(i, 1) = "M30" Then Exit For
- If i > K Then
- If d.exists(brr(i, 1)) Then
- j = j + 1
- CRR(j, 1) = brr(i, 1)
- End If
- End If
- Next
- d.RemoveAll
- For i = 1 To j
- d(CRR(i, 1)) = ""
- Next
- For i = 1 To UBound(Arr)
- If Arr(i, 1) = "T1" Or Arr(i, 1) = "T2" Or Arr(i, 1) = "T3" Or Arr(i, 1) = "M30" Then GoTo 100
- If Not d.exists(Arr(i, 1)) Then
- 100: x = x + 1
- drr(x, 1) = Arr(i, 1)
- End If
- Next
- If j > 0 Then
- [D1].Resize(j) = CRR
- Else
- MsgBox "没有相同数据"
- End If
- If x > 0 Then
- [c1].Resize(x) = drr
- Else
- MsgBox "没有相同数据"
- End If
- End Sub
复制代码重新改过,上面逻辑有问题。
|
|