- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¥»©«³Ì«á¥Ñ 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«Ü¦hWÀ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·|·QnÁ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¥ÎkeynÂo±¼«½ÆÈ,
'¦r¨åªºkeyªº¨Ï¥Î´N¬On·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¸Ì,´Nn§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 |
|