- ©«¤l
- 967
- ¥DÃD
- 0
- ºëµØ
- 0
- ¿n¤À
- 1001
- ÂI¦W
- 0
- §@·~¨t²Î
- WIN XP
- ³nÅ骩¥»
- OFFICE 2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-11-29
- ³Ì«áµn¿ý
- 2022-5-17
|
¦^´_ 1# yuch8663 - Sub xx()
- Dim Ar1(), Ar2()
- Sheets("sheet2").Cells = ""
- Sheets("sheet1").Rows(1).Copy Sheets("sheet2").Rows(1)
- For C = 1 To 15 Step 4
- Set d1 = CreateObject("scripting.dictionary")
- Set d2 = CreateObject("scripting.dictionary")
- Sheets("sheet1").Select
- x = Cells(2, C).End(xlDown).Row
- y = Cells(2, C + 2).End(xlDown).Row
- Ar1 = Range(Cells(2, C), Cells(x, C + 1))
- Ar2 = Range(Cells(2, C + 2), Cells(y, C + 3))
- For I = 1 To UBound(Ar1)
- d1(Ar1(I, 1)) = Ar1(I, 2)
- Next I
- For I = 1 To UBound(Ar2)
- d2(Ar2(I, 1)) = Ar2(I, 2)
- Next I
- For J = 1 To UBound(Ar1)
- If Not d2.Exists(Ar1(J, 1)) Then d1.Remove (Ar1(J, 1))
- Next J
- For J = 1 To UBound(Ar2)
- If Not d1.Exists(Ar2(J, 1)) Then d2.Remove (Ar2(J, 1))
- Next J
- Sheets("sheet2").Cells(2, C).Resize(d1.Count, 1) = Application.Transpose(d1.keys)
- Sheets("sheet2").Cells(2, C + 1).Resize(d1.Count, 1) = Application.Transpose(d1.items)
- Sheets("sheet2").Cells(2, C + 2).Resize(d2.Count, 1) = Application.Transpose(d2.keys)
- Sheets("sheet2").Cells(2, C + 3).Resize(d2.Count, 1) = Application.Transpose(d2.items)
- Erase Ar1: Erase Ar2
- Set d1 = Nothing: Set d2 = Nothing
- Next C
- End Sub
½Æ»s¥N½X
aaa1.rar (13.17 KB)
|
|