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

°}¦C»P¦r¨å

¦^´_ 10# chihminyang88


    ÁÂÁ«e½ú¦^´_,¤@°_¾Ç²ß,ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
¥H¤U¤è®×¬O¤£¥ÎÂà¸m,¦Ó¥H°j°é±N¦r¨åªºkeys»Pitems³v¦¸¼g¤J¤Gºû°}¦C,¦A¼g¤JÀx¦s®æ

Option Explicit
Sub ¦r¨å_Áa¦V¼g¤JÀx¦s®æ¸Ì_1()
Dim xD, A, Brr, R&
'¡ô«Å§iÅܼÆ:(xD,A,Brr)¬O³q¥Î«¬ÅܼÆ,R¬Oªø¾ã¼Æ
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD³o³q¥Î«¬ÅܼƬO ¦r¨å
xD("¦Y") = "©CÄZ­¹ª««á§]¤U"
'¡ô¦r¦ê"¦Y"¬Okey ,¦r¦ê"©CÄZ­¹ª««á§]¤U"¬OItem
xD("³Ü") = "§l¶¼"
'¡ô¦r¦ê"³Ü"¬Okey ,¦r¦ê"§l¶¼"¬OItem
xD("ª±") = "¹CÀ¸"
'¡ô¦r¦ê"ª±"¬Okey ,¦r¦ê"¹CÀ¸"¬OItem
xD("¼Ö") = "³ß®®"
'¡ô¦r¦ê"¼Ö"¬Okey ,¦r¦ê"³ß®®"¬OItem
ReDim Brr(1 To xD.Count, 1 To 2)
'¡ô«Å§iBrr¬O¤Gºû°}¦C,°}¦C½d³òÁa¦V¯Á¤Þ¸¹±q1 ¨ìxD¦r¨åkey¼Æ¶q,
'¾î¦V¯Á¤Þ¸¹±q1 ¨ì2

For Each A In xD.keys
'¡ô³]³v¶µ°j°é,¥OA¬O xD¦r¨å¸Ìªº¨ä¤¤¤@­Ókey
   R = R + 1
   '¡ô¥OR³oªø¾ã¼Æ²Ö¥[1  (PS:R¦b³Ì«e­±«Å§i¬Oªø¾ã¼Æ,©Ò¥Hªì©l­È¬O0)
   Brr(R, 1) = A
   '¡ô¥ORÅܼƦC²Ä1ÄæBrr°}¦C­È¬O AÅܼÆ
   Brr(R, 2) = xD(A)
   '¡ô¥ORÅܼƦC²Ä2ÄæBrr°}¦C­È¬O ¥HAÅܼƬdxD¦r¨å¦^¶ÇªºItem­È
Next
Workbooks.Add
'¡ô¥O·s¼W¤@­Ó¬¡­¶Ã¯
[A1].Resize(UBound(Brr), 2) = Brr
'¡ô¥O·s¼W¬¡­¶Ã¯²Ä1­Ó¤u§@ªí[A1]Àx¦s®æ,ÂX®i¦V¤U(BrrÁa¦V³Ì¤j¯Á¤Þ¦C¸¹)¦C¼Æ,
'ÂX®i¦V¥k2Äæ,¦¹½d³òÀx¦s®æ­È¥HBrr°}¦C­È±a¤J

End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-4-20 09:33 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
½×¾Â¸Ì¨ì³B¦³Ä_ÂÃ,½m²ßªºÃD§÷«Ü¦h
«á¾ÇÂÇ¥H¤UÃìµ²ªº½d¨Ò°µ°}¦C»y¦r¨å¾Ç²ß¤ß±o·J¾ã,½Ð¦U¦ì«e½ú«ü±Ð
http://forum.twbts.com/thread-12012-1-2.html

¸ê®Æªí:


µ²ªGªí:


Option Explicit
Sub ¤ôªGºØÃþ_¤£­«½Æ()
Dim xD, Brr, N&, i&, xR As Range, T$
'¡ô«Å§iÅܼÆ:(xD,Brr)¬O³q¥Î«¬ÅܼÆ,(N,i)¬Oªø¾ã¼Æ,
'xR¬OÀx¦s®æÅܼÆ,T¬O¦r¦êÅܼÆ
'«á¾Ç¥H«e¤£ª¾¹D«Å§iÅܼƪº­«­n©Ê,¸Ñ¨Mµ{¦¡¿ù»~¦Y¤F«Ü¦h­WÀY,
'²{¦b³£²ßºD«Å§iÅܼÆ,¦U¦ì¦P¾Ç¦h½m²ß¦h¾D¹J®À§é´N·|ª¾¹D¬°¤°»ò¤F

Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD³o³q¥Î«¬ÅܼƬO ¦r¨å
Set xR = Range([G1], Cells(Rows.Count, "G").End(xlUp))
'¡ô¥OxR³oÀx¦s®æÅܼƬO¥»ªí[G1]¨ìGÄæ³Ì«á¤@­Ó¦³¤º®eÀx¦s®æ
'´N¬O[G1:G10]³o10®æ,Set xR =[G1:G10]´N¥i¥H¤F!
'¨º¬°¦ó­n¼gªº³o»ò½ÆÂø©O?¦]¬°¸ê®Æ¶q¦pªGÅÜ°Ê!µ{¦¡·|¦Û°Ê°»´ú¦Û°Ê½Õ¾ã

Brr = xR
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥HxRÅܼƭȱa¤J
'¦pªG°Ý¬°¤°»ò­n³o¼Ë³¯­z?
'Excel_VBA±NÀx¦s®æ­È¨ì¶i¥h°}¦C¸Ì´N³o»ò²³æ,¦h­Ó"="´N¨ì¶i¥h¤F

'¬°¤°­n¥Î°}¦C©O?
'¦]¬°Excel¹ï¨Ï¥ÎªÌ¤Ó¦n¤F,Àx¦s®æ¦³«Ü¦hªº³]©wÅý¨Ï¥ÎªÌ«Ü¤è«K¨Ï¥Î,
'¦ý¬Oµ{¦¡­n§ì¨úÀx¦s®æ¤º®e¸ò¼g¤JÀx¦s®æ³£®É­nªá®É¶¡§PŪ¯u¥¿ªº­È¬O¤°»ò,
'­«­nªº¬O±N¸ê®Æ¤@¦¸¼g¤J10­ÓÀx¦s®æ¸Ìªº®É¶¡¤ñ¤@­Ó­Ó¤À10¦¸¼g¤JÀx¦s®æ®É¶¡µu,
'©Ò¥H¦b°}¦C¸Ì°µ¸ê®Æ½s¿è,½s¿è¦n¤F¦A¤@¦¸©Ê¼g¤JÀx¦s®æ¸Ì
'¦b°}¦C¸Ì°µ¸ê®Æªº½s¿è«Ü§Ö,¸Õ¸Õ¬Ý´Nª¾¹D

For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q2 ¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¸¹
   T = Brr(i, 1)
   '¡ô¥OT³o¦r¦êÅܼƬO i°j°é²Ä1ÄæBrr°}¦C­È
   '¬°¤°»òÁÙ­n³o­Ó¨BÆJ?¦h¦¹¤@Á|!
   '°£¤F»{ÃҸ˶iTÅܼƬO¦r¦ê¤§¥~,ÁÙ¥i¥Hºë²µ{¦¡½X,¾AŪ©Ê§ó¦n
   '·í½m²ß®É¬Ý¨ìµ{¦¡½X«Üªø,´N·|·Q­nÁYµuµ{¦¡½X,»°§Ö¦æ°Ê,¦h½m²ß´Nª¾¹D¤F

   If Not xD.Exists(T) Then
   '¡ô¦pªGxD¦r¨åkeys¸ÌÁÙ¨S¦³TÅܼÆ?
   'Àˬd¬Y­Ó¦r¦ê¦b¦r¨å¸Ìkeys¬O¤£¬O¦s¦bªº¤è¦¡´N¬O³o¼Ë
   'If xD.Exists(T) <> Empty Then  '³o¼Ë°Ý¤]¥i¥H

      xD(T) = ""
      '¡ôºÃ°Ý¦pªG½T©wÁÙ¨S¦³!´N¥OTÅܼƬOkey,item¬OªÅ¦r¤¸,¯Ç¤J¦r¨å¸Ì
      '¬°¤°»òitem¬OªÅ¦r¤¸?¦]¬°§Ú­Ì¦¹¦¸¥Î¦r¨å¥u¬O¬°¤F¥Îkey­nÂo±¼­«½Æ­È,
      '¦r¨åªºkeyªº¨Ï¥Î´N¬O­n·f°titem¤~·|¯Ç¤J¦r¨å¸Ì,
      '©Ò¥HitemÀH·Nµ¹­Ó­È¤]¥i¥H

      N = N + 1
      '¡ô¥ON³oªø¾ã¼Æ²Ö¥[1,N«Å§i¬Oªø¾ã¼Æ,©Ò¥Hªì©l­È¬O0,
      '¦]¬°­n§â¦r¨åÂo¦nªºµ²ªG¦r¦ê©ñ¦b¦P¤@­Ó°}¦C¸Ì,´N­n§i¶D¸Ó©ñ­þ¸Ì

      Brr(N, 1) = T
      '¡ô¥ONÅܼƦC²Ä1ÄæBrr°}¦C­È¬OTÅܼÆ
      'ºÃ°Ý??­ì¸ê®Æ¸òµ²ªG©ñ¦b¦P¤@­Ó°}¦C¸Ì¤£·|¶Ã±¼¶Ü?
      '¤£·|!¦]¬°°j°é©¹«á¶],¦Ó¥B¬O±q2¶}©l,§âµ²ªG¸ê®Æ±q³Ì«e­±©ñ,°l¤£¨ì
      '»\±¼­ì¨Ó­È¤£·|¥X°ÝÃD!¤£·|,¦]¬°­ì¸ê®Æ¥Î¹L¤F¤£»Ý­n¤F

   End If
Next
Workbooks.Add
'¡ô¥Oµ{§Ç·s¼W¤@­Ó¬¡­¶Ã¯
[A1].Resize(N, 1) = Brr
'¡ô¥O³o·s¬¡­¶Ã¯²Ä1­Ó¤u§@ªíªº[A1]Àx¦s®æÂX®i¦V¤UNÅܼƮ檺­È¬OBrr°}¦C­È
'¦]¬°¥Oµ{§Ç¼g¤JÀx¦s®æªº½d³ò¥u¦³N­Ó(6­Ó),
'©Ò¥H¶W¥X³o½d³òªº°}¦C­È¤£·|¼g¤JÀx¦s®æ¸Ì

Set xD = Nothing: Set xR = Nothing: Erase Brr
'¡ô¥OÄÀ©ñ³o¨ÇÅܼÆ
End Sub

'=================================================
¸É¥R:
¾î©ñªº¤è¦¡§ó²³æ,»°§Ö¦h§ä½d¨Ò½m²ß

°õ¦æµ²ªG:


µ{¦¡½X¦p¤U:

Sub ¤ôªGºØÃþ_¤£­«½Æ_1()
Dim xD, Brr, i&, xR As Range
Set xD = CreateObject("Scripting.Dictionary")
Set xR = Range([G1], Cells(Rows.Count, "G").End(xlUp))
Brr = xR
For i = 2 To UBound(Brr)
   xD(Brr(i, 1)) = "Good"
Next
Workbooks.Add
[A1].Resize(1, xD.Count) = xD.keys
Set xD = Nothing: Set xR = Nothing: Erase Brr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

Q:
µ{¦¡¬[ºc®É¡A¬O¤£¬O¤@¶}©l´N±NÅܼƨî©w¦n?

A:
¨Ì¦Û¤vªº¸gÅç¥ýÀÀ­Ó¯ó½Z,¦Aµ{¦¡³]­p®É°µ«Å§i¼W´î
³Ì«á±N¤£»Ý­n¥Î¨ìªºÅܼƧR°£§Y¥i
¨Ò¦p
Option Explicit
Sub TEST()
Dim Brr, Crr, V, Y, Z, Q, R&, C&, i&, j&, X&, T$, P$, b#, K%
Dim xR As Range, Ra As Range, Sh As Worksheet
Set Y = CreateObject("Scripting.Dictionary")

Set Y = Nothing: Set xR = Nothing: Erase Brr, Crr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

Andy ¾Ç¥S,§A³o¨Ç¸Ô²Ó,²¼ä,©ö©úªº±Ð¾Ç,¯uªº¥O«á¾ÇÀò¯q¨}¦h....
¦hÁ§AµL¨pªº¤À¨É

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
¤À¨É¤@­Ó«á¾Çµ{¦¡³]­p®Éªº¶]°j°é«á¿ù»~ªºµ²ªG,¯íµM¤£ª¾¦ó³B¥X¿ù®Éªº¸Ñ¨M¤èªk
¥H Sub ²M°£¤£²Å±ø¥óªº¦C_¨Ã±Æ§Ç()³o®×¨Ò¬°¨Ò
http://forum.twbts.com/redirect. ... o=lastpost#lastpost

¥¿½T¸ê®Æ±Æ°£ªk:
1.«Øij±Mª`¦b²Ä¤@­ÓÅý§A§PÂ_¶]§¹µ{¦¡µ²ªG¬O¿ùªº¨º¤@Àþ¶¡¨º­ÓÂIªº¨º­Ó¸£®ü°T®§
¨Ò¦p¬Y¤@µ§(¦C)¸ê®ÆÀ³¸Ó­n¥X²{,¦ý¬O¬°¤°»ò¤£¨£¤F,¦Ó¥LªºÃöÁä¬O¤é´Á¤ñ¸û
2.±N­ì©l¸ê®Æ¸Óµ§ÃöÁä¸ê®Æ«e¤èªº¦C§R°£,Åý°j°éªº²Ä¤@µ§´N¬O¶]³oµ§ÃöÁä¸ê®Æ
Åýµ{¦¡°±¦b¦¹³BÅÞ¿è¹Bºâ³B If CDate(Arr(y, 4)) > Da Then GoTo 101
¬Ý¥Lµ{¦¡«ç»òªº¶]ªk,·f°t Msgbox CDate(Arr(y, 4))  :l Msgbox Da
¦p¦¹ªº¤è¦¡¤ñ¸û¤£·|¯íµM¤£ª¾©Ò±¹
(±N«e¤è¨S¿ù¨S°ÝÃDªº¸ê®Æ³£§R°£,¤~¯à¤è«KÀˬd°ÝÃD©Ò¦b)

³sµ²©«©Ò¥Çªº¿ù,«á¾Ç¦A¦¸¦V¦U¦ì­Pºp
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦U¦ì«á¾Ç¦P¾Ç¤j®a¦n
½×¾Â¸Ì¨ì³B³£¬OÄ_ÂÃ,±`½m²ß´N·|¶i¨B
¤W½×¾Â¤@°_¾Ç²ß

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-6-20 09:10 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æµ²ªG:


ÁÂÁ ­ã´£³¡ªL«e½ú
http://forum.twbts.com/viewthrea ... ;highlight=Scriptin
Option Explicit
Sub ¦r¨å¥HItemº¥¼W±Æ§Ç()
Dim Arr, Brr, Crr, Z, i&, j&, Y&
Arr = Array("¤A", "¤B", "¥Ò", "¤þ")
Brr = Array(300, 500, 200, 400)
Set Z = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(Arr): Z(Arr(i)) = Brr(i): Next
MsgBox "Keys: " & Join(Z.Keys, " , ") & vbLf & "Items: " & Join(Z.Items, " , ")
Arr = Z.Keys: Brr = Z.Items: Y = Z.Count: Z.RemoveAll
ReDim Crr(1 To Y, 1 To 2)
For i = 1 To Y
   For j = i - 1 To 1 Step -1
      If Brr(i - 1) > Crr(j, 2) Then Exit For
      Crr(j + 1, 1) = Crr(j, 1): Crr(j + 1, 2) = Crr(j, 2)
   Next j
   Crr(j + 1, 1) = Arr(i - 1): Crr(j + 1, 2) = Brr(i - 1)
Next
For i = 0 To UBound(Crr) - 1
   Z(Crr(i + 1, 1) & "") = Crr(i + 1, 2)
Next
MsgBox "Keys: " & Join(Z.Keys, " , ") & vbLf & "Items: " & Join(Z.Items, " , ")
Set Z = Nothing: Erase Arr, Brr, Crr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¸Ü¦h¤£¦p¸Ü¤Ö¡A¸Ü¤Ö¤£¦p¸Ü¦n¡C
ªð¦^¦Cªí ¤W¤@¥DÃD