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

[µo°Ý] excel VBA ±q¤j¶q¸ê®Æ¤¤¸Ì§ä¥X¦@¦P­«½Æªº¸ê®Æ

¦^´_ 10# Duck


    ­pºâ¦U¦Û¥Àªº¥X²{²v¤£Ãø¡A¦ý¹ê¦b¤£¸Ñ«e3­Ó¤u§@ªíªº¦r¥À­n¨D¥X²{²v¦b80%¥H¤W
´X¥G¤£¥i¯à°Ú!
°²³]¦³¡A¨º´N¬O­nÅã¥Ü¨ì¤u§@ªí4ªºBÄæ¶Ü?
¨º¸òAÄ檺¸ê®Æ¤S¦³¬Æ»òÃöÁp?
¤W¶Çªº½d¨Ò³Ì¦n¬O¯àÅã¥Ü·Q­nªºµ²ªG¡A§_«h«ÜÃø¬Ý¥X§Aªº»Ý¨D
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¥»©«³Ì«á¥Ñ yen956 ©ó 2015-12-31 20:12 ½s¿è

¦^´_ 4# Hsieh
¶Wª©§A¦n!!
½Ð°Ý: If Application.CountIf(Rng, a) > 1 Then d(a.Value) = ""
¤¤ªº d(a.Value) = "" ¬O¤°»ò·N«ä?
²q·Q¬O±N a ªº Key ¥á¨ì¦r¨å¤¤, ©Î¬O±N a ªº Item ¥á¨ì¦r¨å¤¤,
¦ý¬°¤°»ò¬O d(a.Value) = "" ©O? §@¥Î¬O¤°»ò?
ÁÂÁÂ!!

TOP

¦^´_ 12# yen956

TOP

http://blog.xuite.net/hcm19522/twblog/369872449
¨ç¼Æ °Ñ¦Ò§Y¥i

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2016-1-1 10:16 ½s¿è

¦^´_ 12# yen956
vbaªº»¡©ú
  1. Dictionary ª«¥ó
  2. ª«¥ó¡A¥Î©óÀx¦s¸ê®ÆÃöÁä¦r©M¶µ¥Ø¹ï¡C
  3. »yªk
  4. Scripting.Dictionary
  5. ½Ðª`·N
  6. Dictionary ª«¥ó»P PERL ¬ÛÃö°}¦C¥þµ¥¡C¥i¥H¬O¥ô¦ó«¬¦¡ªº¸ê®Æªº¶µ¥Ø³QÀx¦s¦b°}¦C¤¤¡C¨C­Ó¶µ¥Ø³£»P¤@­Ó°ß¤@ªºÃöÁä¦r¬ÛÃö¡C¸ÓÃöÁä¦r¥Î¨Ó¨ú¥X³æ­Ó¶µ¥Ø¡A³q±`¬O¾ã¼Æ©Î¦r¦ê¡A¥i¥H¬O°£°}¦C¥~ªº¥ô¦ó«¬ºA¡C
  7. ¤U­±ªºµ{¦¡½XÁ|¨Ò»¡©ú¤F¦p¦ó«Ø¥ß¤@­Ó Dictionary ª«¥ó¡G

  8. Dim d                   '«Ø¥ß¤@­ÓÅܼÆ
  9. Set d = CreateObject(Scripting.Dictionary)
  10. d.Add "a", "Athens"     '¥[¤J¤@¨ÇÃöÁä¦r©M¶µ¥Ø
  11. d.Add "b", "Belgrade"
  12. d.Add "c", "Cairo"
½Æ»s¥N½X
9#ªþÀɪºµ{¦¡½X¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim d As Object, E As Variant, AR(1 To 3), i As Integer
  4.     Dim Rng As Range, AX(), M As Variant
  5.     Set d = CreateObject("SCRIPTING.DICTIONARY")
  6.     '¤u§@ªí1-> ¤u§@ªí3  '¥X²{¾÷²v¬°80%ªº¦r¥À*****
  7.     For i = 1 To 3   '"¤u§@ªí1"->"¤u§@ªí3" ¦b¬¡­¶Ã¯¤Wªº Index
  8.          MsgBox Sheets(i).Name  '¥iµù¸Ñ±¼
  9.         With Sheets(i).Range("B:B").SpecialCells(xlCellTypeConstants).Offset(, 1)
  10.             .Cells = "=COUNTIF(C2,RC[-1])/COUNTA(C1)"  'Àx¦s®æ¼g¤W¤½¦¡
  11.             AR(i) = Application.WorksheetFunction.Transpose(.Offset(, -1).Resize(, 2).Value)
  12.             'AR(i) ¾É¤J­^¤å¦r¥À¥X²{¦Ê¤À¤ñ¾÷²v
  13.             For Each E In .Cells
  14.                 If E >= 0.8 Then d(E.Offset(, -1).Value) = ""
  15.             Next
  16.             .Cells = .Value             '¤½¦¡Âର­È
  17.             .NumberFormatLocal = "0%"   '¼Æ¦r®æ¦¡¤Æ
  18.             .Cells.Offset(, 1) = ""
  19.             If d.Count >= 1 Then
  20.                 .Cells(1).Range("B1").Resize(d.Count) = Application.WorksheetFunction.Transpose(d.keys)
  21.             End If
  22.         End With
  23.         d.RemoveAll
  24.     Next
  25.    
  26.     '***¤u§@ªí4 ¤WBÄæ¦ì¤¤¡A¨C­Ó­^¤å¦r¥À¥X²{¦b«ü©w¤u§@ªíªº¤ñ²v***
  27.     Set Rng = Sheets("¤u§@ªí4").Range("A1")
  28.     i = 0
  29.     Do Until Rng Is Nothing
  30.         AX = AR(Sheets(Rng.Value).Index) '"¤u§@ªí1"->"¤u§@ªí3" ¦b¬¡­¶Ã¯¤Wªº Index
  31.         'AR(Sheets(Rng.Value).Index) ¾É¥X¦U­Ó¤u§@ªí¤W­^¤å¦r¥Àªº¾÷²v
  32.         M = Application.Match(Rng.Offset(i, 1), Application.Index(AX, 1), 0)
  33.         'Application.Match ¤u§@ªí¨ç¼Æ
  34.         With Rng.Offset(i, 2) 'CÄæ
  35.             If Not IsError(M) Then
  36.                 .Cells = AX(2, M)
  37.             Else
  38.                 .Cells = 0
  39.             End If
  40.             .NumberFormatLocal = "0%"
  41.         End With
  42.         i = i + 1
  43.         If Rng.Offset(i) <> "" Then  '¤U¤@­Ó¤u§@ªí
  44.             Set Rng = Rng.Offset(i)
  45.             i = 0
  46.         ElseIf Rng.Offset(i, 1) = "" Then '¨S¦³¦r¦ê
  47.             Set Rng = Nothing   'Â÷¶}°j°éªº±ø¥ó
  48.         End If
  49.     Loop
  50. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2016-1-1 11:16 ½s¿è

¦^´_ 12# yen956


d(a.Value) = ""¡@¡Ä¡Äkey ¬° a.value¡@¡A¡@item ¬° ªÅ¦r²Å

keyªÌ¡A¥iºÙ¨ä¬°¡e¯Á¤Þ­È¡f¡A¨ã¡e°ß¤@¤£­«ÂСf©Ê¡A
­Y¥u·Q¨ú¥X¤£­«Âжµ¥Ø¡Aitem ´N¤£¶·³B²z¡A©Ò¥Hµ¹­Ó¥ô·N¸ê®Æ¡A¤@¯ëµ¹ªÅ¦r²Å§Y¥i¡I

­nª`·N¡G¢°¡D¤å¦r®æ¦¡»P¼Æ­È®æ¦¡ªº¯Â¼Æ¦r¡A©Î­^¤åªº¤j¡D¤p¼g¡A©ñ¦b key ¤¤¬Oµø¬°¤£¦Pªº¡I
¡@¡@¡@¡@¢±¡Dkey ªº¨Ó·½­Y¬°¡eÀx¦s®æ°Ñ·Ó¡f¡A¥²¶·¨Ï¥Î rng.value ©Î rng.text ©Î rng & "" ¤è¦¡¡A
¡@¡@¡@¡@¡@¡@³o®É´N¯A¤Î¡e¼Æ­È¡f»P¡e¤å¦r¡f®æ¦¡ªº°ÝÃD¡A¨Ì»Ý¨D¥h¨M©w¨ä®æ¦¡¡I
¡@¡@¡@¡@¡@¡@¨Ò¦p¡G¢Ï¢°¬°¡e¤é´Á¡f2016/01/01¡A¦Û­q®æ¦¡¬°¡eYYYY/MM/DD]¡A¥ç§Y¨ä­È¬°¡e¼Æ­È¡f42370¡A¥u¬O®æ¦¡¬Ý°_¨Ó¬°¤é´Á¡A
¡@¡@¡@¡@¡@¡@¡@¡@¡@¨º»ò¡A[A1].Value¡@¬° 2016/1/1 µ¥¦P 42370
¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@[A1].Text¡@¡@«h¬°¡e¤å¦r¡f2016/01/01
¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@[A1] & ""¡@¡@¤S¬°¡e¤å¦r¡f2016/1/1

Sub ´ú¸Õ()
Set xD = CreateObject("Scripting.Dictionary")
xD([A1].Value) = ""
xD([A1].Text) = ""
xD([A1] & "") = ""
xD(42370) = ""
MsgBox xD.Count¡@'¥u¦³¢²¦Ó«D¢³­Ó¡A¦]²Ä¢°¤Î²Ä¢³¡e­È¡f¬Û¦P
End Sub


¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×
¦Ü©ñ item ¦]¦UºØ»Ý¨D¡A¥i°µ«Ü¦hªºÅܤơA¤@®É»¡¤£²M¡A¥i¦h§ä§ä§ó¦h¹ê»Ú½d¨Ò¬Ý¬Ý¡ã¡ã
¡@

TOP

·PÁÂc_c_lai, GBKEE, ­ã´£³¡ªL µ¥¤j¤jªº»¡©ú,
¦]¬°¤@¯ë¤å¥ó¥u´£¨ì d.Add "a", "Athens" ªº¤èªk,
²{¦bÁ`ºâª¾¹D d(a.Value) = "" ³o­Ó¤èªkªº¯u¥¿¨ç¸q,
d(a.Value) = ""¡@¡Ä¡Äkey ¬° a.value¡@¡A¡@item ¬° ªÅ¦r²Å
ÁÂÁ¤j¤j­Ì¸Ô²Óªº»¡©ú, ÁÂÁÂ!!

TOP

ªá¤F¤£¤Ö®É¶¡, Á`ºâ¹ï Ditionary ¦³¤@ÂIÂI¤F¸Ñ,
d(a.Value) = ""  »P
If Not exists(a.Value) Then d.Add a.Value, "" ¦P¸q.
¤U¦C­×§ï¦Û 15# GBKEEª©¤jªºVBA(ª©¤jªº°õ¦æµ²ªG§¹¥þ¥¿½T),
½Ð«ü±Ð!!
  1. '­×§ï¦Û 15# GBKEEª©¤jªºVBA
  2. Sub Test()
  3.     Dim d As Object, d2 As Object, AR(1 To 3), ArC()
  4.     Dim M As Variant, E As Variant
  5.     Dim LstA As Integer, LstB As Integer, Cnt As Integer, Cnt2 As Integer
  6.     Dim i As Integer, J As Integer
  7.     Set d = CreateObject("SCRIPTING.DICTIONARY")
  8.     Set d2 = CreateObject("SCRIPTING.DICTIONARY")
  9.     Range("C:G").ClearContents    '²M°£¤u§@ªí4 CÄæ-->GÄæ
  10.     Range("E:E").Interior.ColorIndex = xlNone
  11.     LstB = [B65536].End(xlUp).Row
  12.     Cnt = 1
  13.     Cnt2 = 1
  14.     ArC = Array(35, 36, 37, 38)
  15.    
  16.     '¥H¤U­pºâ ¤u§@ªí1-> ¤u§@ªí3 ¥X²{¾÷²v¬°80%ªº¦r¥À*****
  17.     For i = 1 To 3   '±q "¤u§@ªí1" ¨ì "¤u§@ªí3"
  18.         Sheets(i).Range("C:E").ClearContents    '²M°£¨C¤@­¶ªº CÄæ-->EÄæ
  19.         With Sheets(i).[C1].Resize(Sheets(i).[B65536].End(xlUp).Row)   '§Y[C1:Cxx]
  20.             .Cells = "=COUNTIF(C2,RC[-1])/COUNTA(C1)"
  21.             '[C1]¤½¦¡ = COUNTIF(B:B,B1)/COUNTA(A:A), §Y­pºâ¨C­Ó¦r¥À¥X²{ªº¾÷²v
  22.             
  23.             AR(i) = Application.Transpose(.Offset(, -1).Resize(, 2).Value)
  24.             '±N BÄæ,CÄæ Âà¸m¬° AR(1 to 2, 1 to 21)
  25.             
  26.             '±N­^¤å¦r¥À¥X²{¦Ê¤À¤ñ¾÷²v¾É¤J AR(i)
  27.             For Each E In .Cells    '¾ú¹M¨C¤@­¶ªº [C1:Cxx]
  28.                 d2.Item(E.Offset(, -1).Value) = E.Value
  29.                 '±N¦r¥À(Key)¤Î¾÷²v(Item)¥þ³¡¦s¤J ¦r¨åd2 ¤¤(¤£½×¾÷²v¤j¤p)
  30.                
  31.                 If E >= 0.8 Then d(E.Offset(, -1).Value) = E.Value
  32.                 '±N¾÷²v >=80% ªº¦r¥À¤Î¾÷²v, ©ñ¨ì ¦r¨åd ¤¤
  33.             Next
  34.             
  35.             .Cells = .Value             '¤½¦¡Âର­È
  36.             
  37.             If d.Count >= 1 Then
  38.                 .Cells(1).Range("B1").Resize(d.Count) = Application.Transpose(d.keys)   '¶É­Ë¦r¥À¨ì¨C­¶ªº [D1:Dxx]
  39.                 .Cells(1).Range("C1").Resize(d.Count) = Application.Transpose(d.Items)  '¶É­Ë¾÷²v¨ì¨C­¶ªº [E1:Exx]
  40.                 '¡¹³o¸Ì­Y±N .Range("B1") §ï¬° .[B1]
  41.                 '  «h·|¥X²{ "ª«¥ó¤£¤ä´©ÄݩʩΤèªk" ªº¿ù»~!!
  42.             End If
  43.             
  44.             If d2.Count >= 1 Then
  45.                 '©T©w¦¡(¤u§@ªí4ªºAÄæ¤ÎBÄ檺ªí®æ¨Æ¥ý¶ñ¦n)
  46.                 '***¤u§@ªí4¤W BÄæ¦ì¤¤¡A¨C­Ó­^¤å¦r¥À¥X²{¦b«ü©w¤u§@ªíªº¤ñ²v***
  47.                 M = Application.Match(Sheets(i).Name, [A:A])
  48.                 If IsNumeric(M) Then
  49.                     If i = 3 Then
  50.                         LstA = LstB
  51.                     Else
  52.                         LstA = Cells(M, 1).End(xlDown).Row - 1
  53.                     End If
  54.                     For J = M To LstA
  55.                         If d2.Exists(Cells(J, 2).Value) Then
  56.                             Cells(J, 3) = d2(Cells(J, 2).Value)
  57.                         End If
  58.                     Next
  59.                     Cnt = LstA + 1
  60.                 End If
  61.             
  62.                 '¾÷°Ê¦¡(EÄæ(¤u§@ªí¦WºÙ)¤ÎFÄæ(¦r¥À)ªºªí®æ¥ÑVBA¶ñ¤J)
  63.                 '***¤u§@ªí4¤W FÄæ¦ì¤¤¡A¨C­Ó­^¤å¦r¥À¥X²{¦b«ü©w¤u§@ªíªº¤ñ²v***
  64.                 Cells(Cnt2, 5) = Sheets(i).Name    '¤u§@ªí¦WºÙ
  65.                 Cells(1).Range("E" & Cnt2).Resize(d2.Count).Interior.ColorIndex = ArC(i)
  66.                 Cells(1).Range("F" & Cnt2).Resize(d2.Count) = Application.Transpose(d2.keys)   '¶É­Ë¦r¥À
  67.                 Cells(1).Range("G" & Cnt2).Resize(d2.Count) = Application.Transpose(d2.Items)  '¶É­Ë¾÷²v
  68.                 Cnt2 = d2.Count + 1
  69.             End If
  70.         End With
  71.         d.RemoveAll
  72.         d2.RemoveAll
  73.         Sheets(i).Range("C:C", "E:E").NumberFormatLocal = "0%"  '¼Æ¦r®æ¦¡¤Æ
  74.     Next
  75.     Range("C:C", "G:G").NumberFormatLocal = "0%"  '¼Æ¦r®æ¦¡¤Æ
  76. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ¹D¼w¬O´£ª@¦Û§Úªº©ú¿O¡A¤£¸Ó¬O¨þ¥¸§O¤HªºÃ@¤l¡C
ªð¦^¦Cªí ¤W¤@¥DÃD