½Ð±Ð¸ê®Æ·J¾ã°ÝÃD

yuch8663

§Ú¦³¥|±iªí³æ¡Aµ§¼Æ§¡¶W¹L10000µ§¥H¤W¡A¨ä¤¤¥Hsheet1ªºsdata¡Bstockid¨âÄ欰°ò·Ç­n±N¥|±iªí³æªº¬ÛÃö¸ê®Æ¶×¾ã¨ìsheet5¸Ì¡A¨ä¤¤sheet3¸Ì·|¦³­«½Æªº¤é´Á¤£­n½Æ»s¹L¥h¡A¨äµ²ªG¦pªþÀɤº©Ò¥Ü¡A¦]¬°¥Î¨ç¼Æ¨Ó¶]¡A³t«×«D±`ºC¡A·Q½Ð¦U¦ìª©¥D¯àÀ°¦£VBAµ{¦¡­n¦p¦ó¼g?ÁÂÁ¡C Book1.rar (61.44 KB)

¤U¸ü¦¸¼Æ: 24

2010-6-6 22:18

Hsieh

¦^´_ 1# yuch8663

1. Sub Ex()
   
2. Dim Sh As Worksheet, Ar(), A As Range, B As Range, C As Range, s&, i%
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. For Each Sh In Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"))
   
6. With Sh
   
7. Set C = IIf(i = 0 Or i = 2, .[A1], .[C1])
   
8.    For Each A In .Range(C, .[IV1].End(xlToLeft))
   
9.        ReDim Preserve Ar(s)
   
10.        Ar(s) = A.Value
    
11.        s = s + 1
    
12.        For Each B In .Range(A.Offset(1, 0), .Cells(65536, A.Column).End(xlUp))
    
13.           If i = 0 Then
    
14.              d1(.Cells(B.Row, 1) & .Cells(B.Row, 2)) = Array(.Cells(B.Row, 1), .Cells(B.Row, 2))
    
15.              d(.Cells(B.Row, 1) & .Cells(B.Row, 2) & A) = B.Value
    
16.              ElseIf d1.exists(.Cells(B.Row, 1) & .Cells(B.Row, 2)) = True Then
    
17.              d(.Cells(B.Row, 1) & .Cells(B.Row, 2) & A) = B.Value
    
18.           End If
    
19.        Next
    
20.     Next
    
21.     i = i + 1
    
22. End With
    
23. Next
    
24. With Sheet5
    
25. .Cells = ""
    
26. .[A1].Resize(, s) = Ar
    
27. r = d1.Count
    
28. .[A2].Resize(d1.Count, 2) = Application.Transpose(Application.Transpose(d1.items))
    
29. For Each C In .Range(.[C1], .[IV1].End(xlToLeft))
    
30.    For Each A In C.Offset(1, 0).Resize(d1.Count, 1)
    
31.       A = d(.Cells(A.Row, 1) & .Cells(A.Row, 2) & C)
    
32.    Next
    
33. Next
    
34. End With
    
35. End Sub

½Æ»s¥N½X

yuch8663

­è¦^¨ì®a¤¤¥´¶}¹q¸£¬Ý¨ìhsiehª©¥Dªº¦^ÂСA¸U¤À·P¿E¡A«Ý§Ú¥ý¨Ó´ú¸Õ¡A¦p¦³°ÝÃD¦A¨Ó½Ð±Ð¡AÁÂÁÂ!

yuch8663

¦^´_ 3# yuch8663


    ½Ð°Ýhsiehª©¥D¡A¬Q±ß¦^®a´ú¸Õµo¥ý¨â­Ó°ÝÃD¡A½Ð°Ý­n¦p¦ó­×§ï?ÁÂÁ¡C

¤U¸ü (240.37 KB)

2010-6-8 09:24

¤U¸ü (224.27 KB)

2010-6-8 09:25

Book1.rar (28.13 KB)

¤U¸ü¦¸¼Æ: 8

2010-6-8 09:24

GBKEE

¦^´_ 4# yuch8663

1. Sub Ex()
   
2. Dim D As Object, D1 As Object, Sh As Worksheet, Ar(), A As Range, B As Range
   
3. Set D = CreateObject("Scripting.Dictionary")
   
4. Set D1 = CreateObject("Scripting.Dictionary")
   
5. ReDim Preserve Ar(2)
   
6. Ar(0) = Sheets("Sheet1").[A1]
   
7. Ar(1) = Sheets("Sheet1").[B1]
   
8. For Each Sh In Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"))
   
9. With Sh
   
10. For Each A In .Range(.[C1], .[IV1].End(xlToLeft))
    
11. If Not IsNumeric(Application.Match(A, Ar, 0)) Then
    
12. Ar(UBound(Ar)) = A.Value
    
13. ReDim Preserve Ar(UBound(Ar) + 1)
    
14. End If
    
15. For Each B In .Range(A.Offset(1, 0), .Cells(65536, A.Column).End(xlUp))
    
16. D1(.Cells(B.Row, 1) & .Cells(B.Row, 2)) = Array(.Cells(B.Row, 1), .Cells(B.Row, 2))
    
17. D(.Cells(B.Row, 1) & .Cells(B.Row, 2) & A) = D(.Cells(B.Row, 1) & .Cells(B.Row, 2) & A) + B.Value
    
18. Next
    
19. Next
    
20. End With
    
21. Next
    
22. With Sheet5
    
23. .Cells = ""
    
24. .[A1].Resize(, UBound(Ar)) = Ar
    
25. .[A2].Resize(D1.Count, 2) = Application.Transpose(Application.Transpose(D1.ITEMS))
    
26. For Each C In .Range(.[C1], .[IV1].End(xlToLeft))
    
27. For Each A In C.Offset(1, 0).Resize(D1.Count, 1)
    
28. A = D(.Cells(A.Row, 1) & .Cells(A.Row, 2) & C)
    
29. Next
    
30. Next
    
31. End With
    
32. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 4# yuch8663


1.¤é´ÁÄæ¦ì­«½Æ¥u»Ý§ï³o¦æ
Set C = IIf(i = 0, .[A1], .[C1])
2.¦]¬°SHEET1¸òSHEET4ªºeqÄæ¦W­«½Æ¥u»Ý±N¨ä¤¤¤@Äæ§ó¦W§Y¥i

yuch8663

­è¦^®a¶}¹q¸£¬Ý¨ìhsiehª©¥Dªº¸ÑÄÀ¡A«D±`·PÁ¡A¦]¬°§Ú¹ï°}¦Cªº°j°é¤@ª½µLªk²z¸Ñ¡A¦]¦¹·Q­n¦Û¦æ­×§ï«o¤£ª¾¦p¦ó¤U¤â¡A«Ý·|´N¦A¨Ó´ú¸Õ¡A¦P®É¤]·PÁÂGBKEEª©¥D´£¨Ñªºµ{¦¡¡A¤]·|¦P®É°µ´ú¸Õ¡A¦A¦¸·PÁ¡C

Andy2483

¦^´_ 2# Hsieh


    ÁÂÁ«e½ú
¤Ó¼F®`¤F!«á¾Çı±o«ÜÃø!
«á¾Ç¦b¦¹©«¾Ç¨ì«Ü¦hª¾ÃÑ!
±N¤ß±o¦b¦¹µù¸Ñ¤@¤U
¦p¦³«_¥Ç½Ð¨£½Ì!¤]Àµ½Ð«e½ú«ü¥¿¨Ã«ü¾É!

Sub Ex_Hsieh()
Dim Sh As Worksheet, Ar(), A As Range, B As Range, C As Range, s&, i%
'¡ô«Å§iÅܼÆ

Set d = CreateObject("Scripting.Dictionary")
'¡ô¥Od ¬O¦r¨å

Set d1 = CreateObject("Scripting.Dictionary")
'¡ô¥Od1 ¬O¦r¨å

For Each Sh In Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4"))
'¡ô³]¥~°j°é,¥O Sh ¬O4­Ó¤u§@ªí¤§¤@,¶¶µÛ¶]

   With Sh
   '¡ô¥H¤UÃö©óSh ¤u§@ªíªºµ{§Ç
   
      Set C = IIf(i = 0 Or i = 2, .[A1], .[C1])
      '¡ô¥OCÀx¦s®æª«¥óÅܼÆ:¦pªGi³oÅܼƬO0©Î2, CÀx¦s®æ=Shªº[A1]Àx¦s®æ
      ',¦pªGi³oÅܼƤ£¬O0©Î2, CÀx¦s®æ=Shªº[C1]Àx¦s®æ
      
      For Each A In .Range(C, .[IV1].End(xlToLeft))
      '¡ô³]¤¤°j°é,¥OA Àx¦s®æª«¥óÅܼƬO??
      '·íi=0(ªì©l­È):C¬O[A1]Àx¦s®æ,.[IV1].End(xlToLeft)¬O²Ä¤@¦C³Ì¥ªÃ䪺Àx¦s®æ
      '©Ò¥HA ¬O Sheet1 ªº[A1:H1]ªºÀx¦s®æ¤§¤@
      
         ReDim Preserve Ar(s)
         '¡ô½Õ¾ãAr°}¦C¤j¤p¡A«O¯d°}¦C¤º³¡¸ê®Æ
         '¤@¶}©lAr ¬O¤@ºû°}¦C,sªì©l­È¬O0,Ar(0) ¬O¨S¦³¸ê®Æ
         
         Ar(s) = A.Value
         '¡ô¥OAr¬O¼ÐÃD¦Cªº­È
         
         s = s + 1
         '¡ô¥O²Ö¥[1,ÅýAr°}¦C©¹¥k ±Æ¤J¼ÐÃD¦Cªº­È
         
         DDD = .Range(A.Offset(1, 0), .Cells(65536, A.Column).End(xlUp)).Address
         For Each B In .Range(A.Offset(1, 0), .Cells(65536, A.Column).End(xlUp))
         '¡ô³]¤º°j°é,¥O BÀx¦s®æª«¥óÅܼÆ:A¼ÐÃD¦C®æ°¾¤U1®æ¨ì ·íÄ檺³Ì«á¤@®æ
         '·íi=0(ªì©l­È);Sh=Sheet1;A=[A1];B=[A2:A105]
         '©Ò¥H B Sheet1 ªº[A2:A105]ªºÀx¦s®æ¤§¤@
         
            If i = 0 Then
            '¡ô¦pªGi¬Oªì©l­È0,¤]´N¬O¤u§@ªí¬O Sheet1 ®É
            '¥Øªº¬O­n¦¬¶°¼ÐÃDÄæ¨âÄ檺­È»P ¤é´Á&ªÑ¥N¸¹&¼ÐÃD¦C®æ ©é¦r¦êªºkey,Item¬O CreditMoneyÄæ­È
            
               d1(.Cells(B.Row, 1) & .Cells(B.Row, 2)) = Array(.Cells(B.Row, 1), .Cells(B.Row, 2))
               '¡ô±ø¥ó¦¨¥ß®É d1¦r¨å¸Ë¤J ¤é´Á&ªÑ¥N¸¹ ©é¦r¦êªº key ,Item¬O®Ô¤¸¯Àªº¤@ºû°}¦C ¤é´Á;ªÑ¥N¸¹
               
               d(.Cells(B.Row, 1) & .Cells(B.Row, 2) & A) = B.Value
               '¡ô±ø¥ó¦¨¥ß®É d¦r¨å¸Ë¤J ¤é´Á&ªÑ¥N¸¹&¼ÐÃD¦C®æ ©é¦r¦êªºkey,Item¬O CreditMoneyÄæ­È
               
               ElseIf d1.exists(.Cells(B.Row, 1) & .Cells(B.Row, 2)) = True Then
               '¡ô¦pªGi¤£¬O¬Oªì©l­È0:¤u§@ªí¤£¬O Sheet1 ®É
               ',¦Ó¥B d1¦r¨å¸Ì¦³ ¤é´Á&ªÑ¥N¸¹ ©é¦r¦êªº key®É
                  
                  d(.Cells(B.Row, 1) & .Cells(B.Row, 2) & A) = B.Value
                  '¡ô±ø¥ó¦¨¥ß®É d¦r¨å¸Ë¤J ¤é´Á&ªÑ¥N¸¹&¼ÐÃD¦C®æ ©é¦r¦êªºkey,Item¬O CreditMoneyÄæ­È
                  
            End If
         Next
      Next
      i = i + 1
   End With
Next
With Sheet5
'¡ô¥H¤UÃö©ó ²Ä5­Ó¤u§@ªíªºµ{§Ç

   .Cells = ""
   '¡ô¥O©Ò¦³Àx¦s­Ó³£¬OªÅ¦r¤¸
   
   .[A1].Resize(, s) = Ar
   '¡ô§â¦¬¶°¨ìªºAr¼ÐÃD¤@ºû°}¦C±q[A1]¶}©lªºÀx¦s®æ©ñ¶i­È
   
   r = d1.Count
   '¡ô¥Or ¬Od1¦r¨å¸Ì¤¸¯À¼Æ¶q104
   
   .[A2].Resize(d1.Count, 2) = Application.Transpose(Application.Transpose(d1.items))
   '¡ô§â¦¬¶°¨ìd1¦r¨åªºitem(¨âÄæ¼ÐÃD) ±q[A2]¶}©lªºÀx¦s®æ©ñ¶i­È
   
   For Each C In .Range(.[C1], .[IV1].End(xlToLeft))
   '¡ô³]¥~°j°é¥O CÀx¦s®æª«¥óÅܼƬO Sheet5 ªº[C1:AK1]ªºÀx¦s®æ¤§¤@
   '¤]´N¬Oµ²ªGªíªº¼Ð´£¦CÀx¦s®æ
      
      For Each A In C.Offset(1, 0).Resize(d1.Count, 1)
      '¡ô³]¤º°j°é¥O AÀx¦s®æª«¥óÅܼƬO C¼ÐÃD¦CÀx¦s®æ°¾¤U¤@®æ¶}©l,
      '©¹¤U¦J¦C (d1¦r¨å¸Ì¤¸¯À¼Æ¶q) ªºÀx¦s®æ 104®æ ªºÀx¦s®æ¤§¤@
      
         A = d(.Cells(A.Row, 1) & .Cells(A.Row, 2) & C)
         '¡ô¥Î¨â¼ÐÃDÄæ¨â®æ­È»P¼ÐÃD¦C®æ©éªº¦r¦ê·íkey,
         '½Õ¥Xd¦r¨å¸ÌªºItem ­È©ñ¨ìÀx¦s®æ²z
         
      Next
   Next
End With
End Sub

Andy2483

¦^´_ 2# Hsieh

ÁÂÁ«e½ú¤À¨É §â¦r¨å¤¤ªºitem¤@ºû°}¦C Âà¦Ü¶K¤J¤u§@ªí
D1(.Cells(B.Row, 1) & .Cells(B.Row, 2)) = Array(.Cells(B.Row, 1), .Cells(B.Row, 2))
~~~
.[A2].Resize(d1.Count, 2) = Application.Transpose(Application.Transpose(d1.items))
³o«Ü¹ê¥Î!
ÁÂÁÂ!

Andy2483

¦U¦ì«e½ú¦n
«á¾Ç¤µ¤Ñ¹B¥Î¤F¨â¥DÃDªº­«­n§Þ¥©,«÷´ê¥X¤U¦C½d¨Ò
http://forum.twbts.com/thread-22560-1-1.html
»P¥»¥DÃD
http://forum.twbts.com/thread-513-1-1.html
Book1_20001017_7.zip (33.21 KB)

¤U¸ü¦¸¼Æ: 3

2022-10-17 13:43

Àµ½Ð«e½ú­Ì«ü¥¿»P«ü¾É! ÁÂÁÂ
°õ¦æ«e:

¤U¸ü (150.78 KB)

2022-10-17 13:44

°õ¦æ«á:

¤U¸ü (465.3 KB)

2022-10-17 13:43