¦p¦ó±N¦PÀɮפ¤¨âsheet§@¤ñ¸û¡A¦A±N¤ñ¸ûµ²ªG¥t¦s¨ä¥Lsheet¤¤?

ckl520

vba¤p¹à©@¹J¨ì°ÝÃD¡A»Ý­n±N¦PÀɮפ¤¨âsheet§@¤ñ¸û¡A¦A±N¤ñ¸ûµ²ªG
¥t¦s¨ä¥Lsheet¤¤¡C¦p¤U©Ò±Ô¡AÀµ½Ð¦U¦ì°ª¤â¤j¤jÀ°¦£¡C
thanks~

¦p¦ó¤ñ¹ïsheet2 & Sheet3¸ê®Æ¡A¨Ã±N¤ñ¹ïµ²ªG
¦s©ó¨ä¥Lsheet¤¤
1.¨âªÌ³£¦³-->sheet4
2.sheet2¦³¡Asheet3¨S¦³-->Sheet5
3.Sheet3¦³¡Asheet2¨S¦³-->Sheet6

shee2 ¸ê®Æ¦p¹Ïfig.1
sheet3 ¸ê®Æ¦p¹Ïfig.2

ckl520

ÁÂÁÂregister313 ¤j¤j
¥i¥Hwork¤F!

register313

¦^´_ 5# ckl520
1.¤u§@ªícode name §ï¬° name
2.­×¥¿ sheet4~sheet6 AÄæ ·|Åܬ°¤é´Á®æ¦¡¤§°ÝÃD

1. Private Sub CommandButton1_Click()
   
2. Dim d1 As Object, d2 As Object, A As Range
   
3. Dim Ar, Br() As String, Cr
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. Set d2 = CreateObject("Scripting.Dictionary")
   
6. With Sheets("Sheet2")
   
7.   For Each A In .Range("A2:A" & .[A2].End(xlDown).Row)
   
8.     d1.Add A.Value, A.Offset(0, 1).Value
   
9.   Next
   
10. End With
    
11. With Sheets("Sheet3")
    
12. For Each A In .Range("A2:A" & .[A2].End(xlDown).Row)
    
13.     d2.Add A.Value, A.Offset(0, 1).Value
    
14.   Next
    
15. End With
    
16. S = 1
    
17. Ar = d1.keys
    
18. ReDim Preserve Br(1 To d1.Count + d2.Count, 1 To 2)
    
19. For I = LBound(Ar) To UBound(Ar)
    
20.   If d2.Exists(Ar(I)) Then
    
21.      Br(S, 1) = Ar(I): Br(S, 2) = d1(Ar(I)): d1.Remove (Ar(I)): S = S + 1
    
22.      d2.Remove (Ar(I)): S = S + 1
    
23.   End If
    
24. Next I
    
25. For I = 4 To 6
    
26.   Sheets("Sheet" & I & "").[A:B] = ""
    
27.   Sheets("Sheet" & I & "").[A1:B1] = Array("P/N", "Location")
    
28.   Sheets("Sheet" & I & "").[A:B].NumberFormatLocal = "@"
    
29. Next I
    
30. Sheets("Sheet4").[A2].Resize(UBound(Br, 1), 2) = Br
    
31. Sheets("Sheet5").[A2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
    
32. Sheets("Sheet5").[B2].Resize(d1.Count, 1) = Application.Transpose(d1.items)
    
33. Sheets("Sheet6").[A2].Resize(d2.Count, 1) = Application.Transpose(d2.keys)
    
34. Sheets("Sheet6").[B2].Resize(d2.Count, 1) = Application.Transpose(d2.items)
    
35. End Sub

½Æ»s¥N½X

ckl520

TO:register313
http://www.badongo.com/file/27212832

thanks~

register313

¦^´_ 3# ckl520

½Ð¤W¶ÇexcelÀ£ÁYÀÉ

ckl520

register313  ¤j¤j §A¦n:

1.®M¥Î«á¡Aµ{¦¡·|¥d¦b³o¦æ Sheet4.[A2].Resize(UBound(Br, 1), 2) = Br

2.¤w¬d¹Lºô¤W¸ê®Æ¡A¦ýÁÙ¬O¬Ý¤£¤ÓÀ´¡AµLªk±Æ»Ù¡C¯à·Ð½Ð¤j¤j¤À¬q¸ÑÄÀµ{¦¡·N«ä¡C

¦A¦¸·PÁ°ª¤âÀ°¦£¡C
thanks~

register313

¦^´_ 1# ckl520

³]sheet2~sheet6 ¤§AÄ欰P/N , BÄ欰Location

1. Sub XX()
   
2. Dim d1 As Object, d2 As Object, A As Range
   
3. Dim Ar, Br()
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. Set d2 = CreateObject("Scripting.Dictionary")
   
6. With Sheet2
   
7.   For Each A In .Range("A2:A" & .[A2].End(xlDown).Row)
   
8.     d1.Add A.Value, A.Offset(0, 1).Value
   
9.   Next
   
10. End With
    
11. With Sheet3
    
12. For Each A In .Range("A2:A" & .[A2].End(xlDown).Row)
    
13.     d2.Add A.Value, A.Offset(0, 1).Value
    
14.   Next
    
15. End With
    
16. S = 1
    
17. Ar = d1.keys
    
18. ReDim Preserve Br(1 To d1.Count + d2.Count, 1 To 2)
    
19. For I = LBound(Ar) To UBound(Ar)
    
20.   If d2.Exists(Ar(I)) Then
    
21.      Br(S, 1) = Ar(I): Br(S, 2) = d1(Ar(I)): d1.Remove (Ar(I)): S = S + 1
    
22.      Br(S, 1) = Ar(I): Br(S, 2) = d2(Ar(I)): d2.Remove (Ar(I)): S = S + 1
    
23.   End If
    
24. Next I
    
25. For I = 4 To 6
    
26.   Sheets(I).[A:B] = ""
    
27.   Sheets(I).[A1:B1] = Array("P/N", "Location")
    
28. Next I
    
29. Sheet4.[A2].Resize(UBound(Br, 1), 2) = Br
    
30. Sheet5.[A2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
    
31. Sheet5.[B2].Resize(d1.Count, 1) = Application.Transpose(d1.items)
    
32. Sheet6.[A2].Resize(d2.Count, 1) = Application.Transpose(d2.keys)
    
33. Sheet6.[B2].Resize(d2.Count, 1) = Application.Transpose(d2.items)
    
34. End Sub

½Æ»s¥N½X