楼主
xmyjk |
Q:如何将sheet1和sheet2中，均出现的公司名称筛选至sheet3
原帖链接：http://www.exceltip.net/thread-24509-1-1.html
A:使用字典和数组方法处理，代码如下：
- Option Explicit
- Sub same()
- Dim i As Long, n As Long, arr, brr(), nm As Long
- Dim d
- Set d = CreateObject("Scripting.Dictionary")
- n = Worksheets(1).[b65536].End(xlUp).Row
- arr = Worksheets(1).Range("b2:b" & n)
- For i = 1 To UBound(arr)
- d(arr(i, 1)) = ""
- Next
- Erase arr
- n = Worksheets(2).[b65536].End(xlUp).Row
- arr = Worksheets(2).Range("b2:b" & n)
- For i = 1 To UBound(arr)
- If d.exists(arr(i, 1)) Then
- nm = nm + 1
- ReDim Preserve brr(1 To 1, 1 To nm)
- brr(1, nm) = arr(i, 1)
- End If
- Next
- Worksheets(3).Columns("a").Clear
- Worksheets(3).[a1].Resize(UBound(brr, 2), UBound(brr, 1)) = Application.Transpose(brr)
- Erase arr, brr
- Set d = Nothing
- End Sub
 提取.rar
|
3楼
liuguansky |
- Sub JusTTesT()
- Dim D, Arr(), n As Byte, Ar, sn As Byte, i&, j As Byte, K&, ArrR() As String
- Set D = CreateObject("scripting.dictionary")
- ReDim Arr(1 To Sheets.Count - 1)
- For sn = 1 To Sheets.Count
- If Sheets(sn).Name <> "汇总" Then
- n = n + 1
- Arr(n) = Sheets(sn).Range("a1").CurrentRegion.Value
- For i = 1 To UBound(Arr(n), 1)
- If Trim(Arr(n)(i, 4)) = "个人" And Trim(Arr(n)(i, 5)) = "新进" Then
- If D.exists(Arr(n)(i, 1)) Then
- Ar = D(Arr(n)(i, 1)): Ar(2) = Ar(2) + 1: D(Arr(n)(i, 1)) = Ar
- K = K + 1: ReDim Preserve ArrR(1 To 7, 1 To K)
- For j = 1 To 7
- ArrR(j, K) = Arr(n)(i, j)
- Next j
- If D(Arr(n)(i, 1))(2) = 1 Then
- K = K + 1: ReDim Preserve ArrR(1 To 7, 1 To K)
- For j = 1 To 7
- ArrR(j, K) = Arr(D(Arr(n)(i, 1))(0))(D(Arr(n)(i, 1))(1), j)
- Next j
- End If
- Else
- D.Add Arr(n)(i, 1), Array(n, i, 0)
- End If
- End If
- Next i
- End If
- Next sn
- With Sheets("汇总")
- .UsedRange.Clear
- With .Range("a1").Resize(K, 7)
- .Value = Application.Transpose(ArrR)
- .Sort Range("A1")
- End With
- .Range("a1").Select
- End With
- Set D = Nothing
- End Sub
试试，是这样的效果吧？
股东.rar
有新问题，一般建议是重新发提问贴 。 |