ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

§Ú¦³¥|±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)

¦^´_ 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
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

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

TOP

¦^´_ 3# yuch8663


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


Book1.rar (28.13 KB)

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2010-6-8 17:27 ½s¿è

¦^´_ 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

TOP

¦^´_ 4# yuch8663


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

TOP

­è¦^®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

TOP

¦^´_ 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

TOP

¦^´_ 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«Ü¹ê¥Î!
ÁÂÁÂ!

TOP

¦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)
Àµ½Ð«e½ú­Ì«ü¥¿»P«ü¾É! ÁÂÁÂ
°õ¦æ«e:


°õ¦æ«á:

TOP

        ÀR«ä¦Û¦b : §g¤l¥ß«í§Ó¡A¤p¤H«í¥ß§Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD