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

[µo°Ý] ¦p¦ó¨Ï¥ÎVBA©Î¨ç¼Æ°µ¦h­Ó°}¦C¼Æ­Èªº¤ñ¸û¤Î®æ¦¡¤Æ±ø¥óªº³]©w

[µo°Ý] ¦p¦ó¨Ï¥ÎVBA©Î¨ç¼Æ°µ¦h­Ó°}¦C¼Æ­Èªº¤ñ¸û¤Î®æ¦¡¤Æ±ø¥óªº³]©w

¥»©«³Ì«á¥Ñ GBKEE ©ó 2012-12-17 15:51 ½s¿è

Dear ¦U¦ìª©¥D©Î°ª¤â¤j¤j­Ì :
  ¤p§Ì¥ý«e½Ð±Ð¹L¦U¦ìª©¥D¤Î¤j¤jªº¤@¨Ç¥¨¶°ªº°ÝÃD,¤]·PÁ¦U¦ìªº¤£§[«ü±Ð,¤µ¦³¤@­Ó°ÝÃD,¤w¸g·Ð¤F§Ö¤@­Ó¤ë,¤w¹M¾ú°ê¥~¦U¤jºô¯¸vba©Î¨ç¼Æªº¨Ò¤l,¤´µLªk¸Ñ¨M§xÂZ¤w¤[ªº°ÝÃD
§Æ±æ¥i¥H±q¦U¦ìª©¥D©Î°ª¤â¤j¤j­Ì´M±o¨ó§U,ÁÂÁÂ!
¥H¤U¤¶²Ð´X­Óºô¯¸ÁÙº¡¤£¿ùªº:
http://www.get-digital-help.com/category/excel/table/
http://chandoo.org/wp/2009/03/25/using-array-formulas-example1/
http://www.contextures.com/tiptech.html

¤p§Ì·Q¨Ì«ü©w¸ô®|¤U¤§¸ê®Æ§¨§ä¨ì¸ê®Æ§¨¤º¤§ÀÉ®×,§@¦Û°Ê·s¼W®Ö¨ú¤è¶ô¼Æ¶q,¦p¥H¤U¹Ï¤ù¦³3­Ó¤å¦rÀɤº®e¤w³Q¤p§Ì¸ü¤Jexcel¤º,­n¦p¦ó¤ñ¸û¦Uµ§¤§¬Û¦P¦ì§}¤§¸ê®Æ,¬O§_­«ÂÐ?¦p¦³
­«ÂШípºâ­«ÂЦ¸¼Æ°£¥H®Ö©w¤ù¼Æ,§@¦Ê¤À¤ñ¤§®æ¦¡¤Æ±ø¥óªºÃC¦â¤ÀÃþ,¦p¤U¹Ï©Ò¥Ü



´M§ä¦U²Õ¼Æ¬Û¦P¦ì¤§¬O§_­«ÂЩοW¥ß¤§¼Æ­È§@¦Ê¤À¤ñ®æ¦¡¤Æ±ø¥ó.zip (13.93 KB)

¦^´_ 1# cmo140497
¸Õ¸Õ¬Ý
  1. Sub AddCheckBox() '¥[¤J®Ö¨ú¤è¶ô
  2. '¦]¬°¨S¦³´£¨Ñ¤å¦rÀÉ¡A¥H²{¦³Item§@¬°·s¼W±ø¥ó
  3. With Sheet1
  4. .CheckBoxes.Delete
  5. k = Application.CountIf(.Columns("E"), "ID")
  6. Set A = .Columns("F").Find("Item", lookat:=xlPart)
  7. For i = 1 To k
  8.   With .CheckBoxes.Add(.Cells(i + 4, "C").Left, .Cells(i + 4, "C").Top, .Cells(i + 4, "C").Width, .Cells(i + 4, "C").Height)
  9.      .Characters.Text = A
  10.   End With
  11.   Set A = .Columns("F").FindNext(A)
  12. Next
  13. End With
  14. End Sub
  15. Sub ¤ñ¹ï()
  16. Dim Sp As Shape, Rng As Range, A As Range, MyRng As Range
  17. With Sheet1
  18.    For Each Sp In .Shapes
  19.      If Sp.Name Like "Check Box*" Then
  20.      Set A = .Columns("F").Find(Sp.OLEFormat.Object.Caption)
  21.       If Sp.OLEFormat.Object.Value = 1 Then
  22.       If Rng Is Nothing Then
  23.          Set Rng = A.Offset(1, 0).Resize(5, 5)
  24.          Else
  25.          Set Rng = Union(Rng, A.Offset(1, 0).Resize(5, 5))
  26.        End If
  27.        End If
  28.      End If
  29.     Next
  30.     Set MyRng = .[M3:Q7]
  31. If Not Rng Is Nothing Then
  32.   For i = 1 To 5
  33.      For j = 1 To 5
  34.      If MyRng(i, j) <> 0 And MyRng(i, j) <> "___" Then
  35.        For Each ar In Rng.Areas
  36.          If ar(i, j) = MyRng(i, j) Then p = p + 1
  37.        Next
  38.        s = p / Rng.Areas.Count: p = 0
  39.        n = Application.Lookup(s, Array(0, 0.1, 0.2, 0.4, 0.6, 0.8, 1), Array(1, 2, 3, 4, 5, 6, 7))
  40.        MyRng.Cells(i, j).Interior.ColorIndex = .[S2:Y2].Cells(1, n).Interior.ColorIndex
  41.        Else
  42.        MyRng.Cells(i, j).Interior.ColorIndex = -4142
  43.     End If
  44.      Next
  45.   Next
  46. End If
  47. End With
  48. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 2# Hsieh


    ¹ê¦b¤j¤jªº·PÁÂHsieh ¶W¯Åª©¥Dªº³»¤O¨ó§U,½Ð°Ýª©¥D±z¤j·§¼g³o­Óµ{¦¡ªá¤F¦h¤Ö®É¶¡,¤p§Ì¬Q±ßpoªº,¤~­è¤W¯Z¥´¶}¹q¸£´N¦¬¨ì¦^ÂФF,¹ê¦b¥O¤p§Ì¦³ÂI....:'(

¥tÁÙ¦³¤@­Ó°ÝÃD·Q½Ð±Ðª©¥D,Ãö©ó©³¤U³o¦æ,³o°}¦C¬O¤p§Ì¦Û¤v¥Îºâªº,½Ð°Ý­n¦p¦ó¦Û¦æ°µ°}¦C¤§¹Bºâ(¤ñ¸û/¦X¨Ö),±N¦³­«ÂЩοW¥ß­È¥N¦Ü·sªº°}¦C¤º,¤´Ä~Äò°µ±ø¥ó®æ¦¡¤Æ¦Ê¤À¤ñ,
Set MyRng = .[M3:Q7]
¦]¬°³o°}¦C¦³¥i¯àx/y·|¦³20~50¤§¦h,¦pªG¥i¥H¦Û¦æ¤ñ¸û¥Xµ²ªGªº¸Ü.....¦A«×·PÁª©¥D¤£Ã㨯­Wªº¸Ñ¨M·s¤â¤p§Ìªº§xÂZ,¹ê¦b·P®¦!

TOP

¦^´_  Hsieh


    ¹ê¦b¤j¤jªº·PÁÂHsieh ¶W¯Åª©¥Dªº³»¤O¨ó§U,½Ð°Ýª©¥D±z¤j·§¼g³o­Óµ{¦¡ªá¤F¦h¤Ö®É¶¡,¤p ...
cmo140497 µoªí©ó 2012-12-17 09:12


¥Î¦h¤Ö®É¶¡¨Ã¤£­«­n¡A¬O§_¹F¨ì»Ý¨D¤~¬O­«ÂI
¦Ü©óMyRng¬O­n¤ñ¹ï§ïÅÜÃC¦âªº°Ï°ì
¦Ü©ó§A­n¦h­Ó½d³ò´N¬Ý§Aªºªí®æ¤À§G³W«h¦Ó©w
¤W¶ÇÀɮ׸ոլݧa
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 2# Hsieh


    ¤£¦n·N«ä,ª©¥D¦A«×¥´ÂZ±z,­è¤~§Ñ°Oªþ¤W¤å¦rÀÉ.
¦pªG¦U°}¦C¦ì§}ªº­È§¡¤£¬Û¦P,«hµø¬°100%,¥N½X7ªºÃC¦â,¤£ª¾¬O§_¥i¦æ,·PÁ±z¡C


test-g2.zip (800 Bytes)

TOP

¦^´_ 4# Hsieh


    ¤£¦n·N«ä,¤p§Ì¨S¨Ó±o¤Î¬Ý¦^ÂÐ,¤S¥á¤FºÃ°Ýµ¹±z,¹ê¦b©êºp.
¤p§Ìªº°}¦C§¡¬°¤Gºû,¦æ¦C¼Æ¦³®É¥i¯à·|¦h¹F20§ó¬Æ¦h,¤º®e¥u¦³©T©w¤§¼Æ­ÈF00~F150,¨S¦³¨ä¥¦¼Æ­È©Î¤å¦r,¥u¬O°}¦C¼Æ¶·¨Ì¹ê»ÚÀɮ׼Ʀөw,­n¿z¿ï©Î¤ñ¹ï«h¥Ñ¤H¦Û¦æ¨M©w,
¸ê®ÆªþÀɦp¤Uªþ¥ó,½Ð°Ñ¦Ò,¦A«×·PÁÂ,ÁÂÁÂ!

´M§ä¦U²Õ¼Æ¬Û¦P¦ì¤§¬O§_­«ÂЩοW¥ß¤§¼Æ­È§@¦Ê¤À¤ñ®æ¦¡¤Æ±ø¥ó.zip (31.73 KB)

TOP

¦^´_ 6# cmo140497


   ³o¼Ë¤w¸g¿ù¶Ã¤F¡A½Ð»¡©ú§Aªº¾ãÅé¬yµ{
©ÒªþªºtxtÀɮ׬O­n¼g¤JE:JÄæ¦ì©Î¬O­n©ñ¨ìM:QÄæ§@¬°¤ñ¹ïÅܦâÀx¦s®æ?
³o¨Ç¤å¦rÀɸê®Æ©Ò§Î¦¨ªº°}¦CÄæ¡B¦C¼Æ¥i¯à¬O¤£¦Pªº¡A¨º»òÃC¦â¹ï·Óªí[S2:Y2]ªº¦ì¸m¬O§_¤S­n§ïÅÜ?
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 7# Hsieh

¤£¦n·N«ä,¤p§Ì¦A¾ã²z¤@¤U¬yµ{,¦A³Â·Ðª©¥D±z¦AÀ°¤p§Ì¬Ý¤@¤U,¦A«×¥´ÂZ±z¤F,ÁÂÁÂ!

   


test3.zip (33.77 KB)

TOP

¦^´_ 8# cmo140497
AUTO_OPEN() Àɮ׶}±Ò®É¦Û°Ê°õ¦æ
  1. Option Explicit
  2. Sub AUTO_OPEN() '¥[¤J®Ö¨ú¤è¶ô'¦]¬°¨S¦³´£¨Ñ¤å¦rÀÉ¡A¥H²{¦³Item§@¬°·s¼W±ø¥ó
  3.     Dim A As Range, K As Integer, i As Integer
  4.     With Sheet1
  5.         .CheckBoxes.Delete
  6.         .Range("B:Z").Interior.ColorIndex = xlNone
  7.         K = Application.CountIf(.Columns("A"), "ID")
  8.         Set A = .Columns("A").Find("ID", lookat:=xlPart)
  9.         For i = 1 To K
  10.         Cells(i + 5, "AA").Select
  11.             With .CheckBoxes.Add(.Cells(i + 5, "AA").Left, .Cells(i + 5, "AA").Top, .Cells(i + 5, "AA").Width, .Cells(i + 5, "AA").Height)
  12.                 .Characters.Text = "Item" & i
  13.                 .Name = "Item" & i
  14.                 .OnAction = "EX"                              'CheckBoxes «ü¥¨¶°ªº µ{¦¡
  15.             End With
  16.             A.Offset(1, 1).Resize(24, 24).Name = "_Item" & i  '¸ê®Æ½d³ò³]¥ß¦WºÙ:¦p¤u§@ªí©w¸q¦WºÙ
  17.             Set A = .Columns("A").FindNext(A)
  18.         Next
  19.         '**  »s©w¦Ê¤À¤ñ ¬° 7 µ¥¤À [S1:Y1] ¦Ê¤À¤ñ¥Ñ¤j¨ì¤p   ***
  20.         For i = 1 To 7  '¦Ê¤À¤ñ¥Ñ¤j¨ì¤p   
  21.             .[AA2].Cells(1, i) = 1 + (1 / 7) - (i / 7)
  22.         Next
  23.     End With
  24. End Sub
  25. Sub EX()   '¤w°õ¦æAUTO_OPEN, «ö¿ïCheckBoxesªºµ{¦¡
  26.     Dim Rng(0 To 25) As Range, S, i
  27.     Dim P As Integer, B As CheckBox, E As Variant
  28.     With Sheet1
  29.          .Range("B:Z").Interior.ColorIndex = xlNone
  30.         For Each B In .CheckBoxes
  31.             If B = 1 Then                                               'CheckBoxe¡F¤Ä¿ï = 1
  32.                 P = P + 1
  33.                 If Not Rng(0) Is Nothing Then
  34.                     Set Rng(0) = Union(Rng(0), .Range("_" & B.Name))
  35.                     For i = 1 To 24                                     '¤w¤Ä¿ï½d³ò¤§ ²Ä1Äæ-²Ä24Äæ
  36.                         For Each E In Rng(0).Areas
  37.                             Set Rng(i) = Union(E.Columns(i), Rng(i))    '¦P¤@Äæ¦ì ³]¬°¦P¤@½d³ò
  38.                         Next
  39.                     Next
  40.                 Else
  41.                     Set Rng(0) = .Range("_" & B.Name)
  42.                     For i = 1 To 24
  43.                         Set Rng(i) = Rng(0).Columns(i)
  44.                     Next
  45.                 End If
  46.             End If
  47.         Next
  48.         If P = 0 Then Exit Sub
  49.         Application.ScreenUpdating = False
  50.         For i = 1 To 24                                     '½d³ò¦³24Äæ
  51.             .Columns(Columns.Count - 1) = ""                '²M°£ ³Ì«á²Ä2Äæ¸ê®Æ
  52.             .Columns(Columns.Count) = ""                    '²M°£ ³Ì«á1Äæ¸ê®Æ
  53.             Rng(i).Copy Cells(1, Columns.Count)             '½Æ»sÄ檺¸ê®Æ
  54.             .Columns(Columns.Count).AdvancedFilter xlFilterCopy, .Cells(1, Columns.Count - 1), Unique:=True
  55.             '¶i¶¥¿z¿ï:¿ï¨ú¤£­«½Æªº¸ê®Æ,´î¤Ö°j°é.
  56.             .Columns(Columns.Count - 1).Sort Key1:=.Cells(1, Columns.Count - 1), Order1:=xlDescending, Header:=xlNo
  57.             '±Æ§Ç : ¤£­nªº¸ê®Æ¸m©ó©³³¡
  58.             Set Rng(25) = .Columns(Columns.Count - 1).Cells(1)   '³]©w­n´M§äªº¦r¦ê
  59.             
  60.             With Rng(i)
  61.                 Do Until Rng(25) = "___" Or Rng(25) = "0" Or Rng(25) = ""
  62.                     Set Rng(0) = .Find(Rng(25), lookat:=xlWhole)
  63.                     If Not Rng(0) Is Nothing Then
  64.                         .Replace Rng(25), "=xxx", xlWhole               '¦p¦P¤u§@ªí´M§ä:¥þ³¡¨ú¥N ¬°¿ù»~ªº¤½¦¡
  65.                         .SpecialCells(xlCellTypeFormulas).Select
  66.                         S = Application.CountA(Selection) / P
  67.                        If S <= 1 Then
  68.                             S = Application.Match(S, [AA2:AG2], -1)     'Match ªº±Æ§Ç:¤j¨ì¤p
  69.                         Else
  70.                             S = 1
  71.                        End If
  72.                         Selection.Value = Rng(25)                       '´_­ì ¨ú¥Nªº¦r¦ê
  73.                         Selection.Interior.ColorIndex = Sheet1.[AA2].Cells(1, S).Interior.ColorIndex
  74.                     End If
  75.                 Set Rng(25) = Rng(25).Offset(1)                         '´M§ä¤U¤@­Ó¦r¦ê
  76.                 Loop
  77.             End With
  78.         Next
  79.         .Columns(Columns.Count - 1) = ""                '²M°£ ³Ì«á²Ä2Äæ¸ê®Æ
  80.         .Columns(Columns.Count) = ""                    '²M°£ ³Ì«á1Äæ¸ê®Æ
  81.         Application.ScreenUpdating = True
  82.         .CheckBoxes(Application.Caller).TopLeftCell.Select
  83.       End With
  84. End Sub
½Æ»s¥N½X

TOP

¦^´_ 9# GBKEE


    ¦A«×·PÁª©¥DÀ°¤p§Ì¸Ñ¨M³o­Ó§xÂZ¤w¤[ªº°ÝÃD,¤£¹L¤p§Ì¦b¸Õrunªº®É­Ô,¥X²{¤F¤@­Ó°ÝÃD,¦p¤U¹Ï¥Ü©Ò¥Ü,¹ê¦b¤£ª¾¹D¦p¦ó§@troubleshooting,¦A³Â·Ðª©¥D¤@¤U,·P®¦


TOP

        ÀR«ä¦Û¦b : °µ¦n¨Æ¤£¯à¤Ö§Ú¤@¤H¡A°µÃa¨Æ¤£¯à¦h§Ú¤@¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD