- ©«¤l
- 231
- ¥DÃD
- 55
- ºëµØ
- 0
- ¿n¤À
- 293
- ÂI¦W
- 0
- §@·~¨t²Î
- winxp
- ³nÅ骩¥»
- office2003
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- ¨Ó¦Û
- KEELUNG
- µù¥U®É¶¡
- 2010-7-24
- ³Ì«áµn¿ý
- 2018-8-28
|
§A¦n¡G
§Aªº´£°ÝÅý§Ú¤]¦³¾Ç²ßªº¾÷·|¡C
ÁÂÁ§A¡I
½Ð¸Õ¸Õ¤U¦C¬O§_¥i¾A¥Î¡C
Sub aa()
Dim mSht As Worksheet
Dim mRng1 As Range, mRng2 As Range, E As Range
Dim mDic1 As Object
Dim mDic2 As Object
Dim mData1(), mData2()
Dim s1%, s2%
Dim key1, key2
Set mDic1 = CreateObject("scripting.dictionary")
Set mDic2 = CreateObject("scripting.dictionary")
Set mSht = Worksheets(1)
With mSht
Set mRng1 = .Range("a1", .Range("a" & .Rows.Count).End(xlUp))
Set mRng2 = .Range("b1", .Range("b" & .Rows.Count).End(xlUp))
For Each E In mRng1
If Not mDic1.Exists(E.Value) Then
mDic1.Add (E.Value), E.Value
Else
ReDim Preserve mData1(s1)
mData1(s1) = E.Value
s1 = s1 + 1
End If
Next
For Each E In mRng2
If Not mDic2.Exists(E.Value) Then
mDic2.Add (E.Value), E.Value
Else
ReDim Preserve mData2(s2)
mData2(s2) = E.Value
s2 = s2 + 1
End If
Next
.Range("e6") = "«½Æ¼ÆÈ"
.Range("e6:f6").Merge
.Range("e7").Resize(s1) = Application.Transpose(mData1)
.Range("f7").Resize(s2) = Application.Transpose(mData2)
'mKey2 = mDic2.Keys
'mItem2 = mDic2.Items
Erase mData1
Erase mData2
s1 = 0
s2 = 0
For Each key1 In mDic1.Keys
If key1 <> mDic2(key1) Then
ReDim Preserve mData1(s1)
mData1(s1) = key1
s1 = s1 + 1
End If
Next
For Each key2 In mDic2.Keys
If key2 <> mDic1(key2) Then
ReDim Preserve mData2(s2)
mData2(s2) = key2
s2 = s2 + 1
End If
Next
.Range("i1") = "AÄæ¯Ê¤§¼ÆÈ"
.Range("j1") = "BÄæ¯Ê¤§¼ÆÈ"
.Range("i2").Resize(s1) = Application.Transpose(mData1)
.Range("j2").Resize(s2) = Application.Transpose(mData2)
End With
Set mDic1 = Nothing
Set mDic2 = Nothing
Set mRng1 = Nothing
Set mRng2 = Nothing
End Sub |
|