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

[µo°Ý] ¦p¦ó§Q¥ÎVBA«öÁä¡A±N«ü©w¤é´Á¶ñº¡ÃC¦â?

[µo°Ý] ¦p¦ó§Q¥ÎVBA«öÁä¡A±N«ü©w¤é´Á¶ñº¡ÃC¦â?

°ÝÃD
¦p¦ó§Q¥ÎVBA«öÁä¡A±N«ü©w¤é´Á¶ñº¡ÃC¦â?

°ÝÃD¸Ô²Ó¤º®e
CÄæ(C3¶}©l)¦P¤@ºØ®Æ¸¹¸Ì¡A¹ïÀ³FÄæ­Y¥u¦³¤µ¤Ñ¤é´Á(¥Ø«e¥ý°²³]¬°2016/11/9¡A¤§«á·|¥H¤½¦¡ =TODAY() ¨ú¥N)¡A«h¶ñº¡¬õ¦â¡F
¹ïÀ³FÄæ­Y "¥u¦³" ¤µ¤Ñ»P¥ô¤@¤Ñ¡A¨âºØ¤é´Á¡A«h¶ñº¡¯»¬õ¦â(±N¥ô¤@¤Ñ¤é´Á¶ñº¡¯»¬õ¦â§Y¥i)¡F


µù
AÄæ "¿z¿ï¨Ò¥~®Æ¸¹" ¥\¯à»¡©ú¡G
¦bAÄæ¿é¤J®Æ¸¹¡A¸Ó®Æ¸¹Áa¨Ï²Å¦X¶ñº¡(¯»)¬õ¦â±ø¥ó¤]¤£¶ñº¡ÃC¦â

¥H¤W°ÝÃD¡A½Ð¦U¦ìVBA°ª¤H°Ñ¦Òªþ¥óÀ°¸Ñ¡A·PÁ¸U¤À¡C

ªþ¥ó¤U¸ü
¦p¦ó§Q¥ÎVBA«öÁä¡A±N«ü©w¤é´Á¶ñº¡ÃC¦â.rar (16.38 KB)

  1. Sub test()
  2. Dim d,d1,m%,n%,i%,j%,Rng, found
  3. Set d = CreateObject("scripting.dictionary")
  4. Set d1 = CreateObject("scripting.dictionary")
  5. Range("c3:f" & Cells(Rows.Count, 3).End(xlUp).Row).Interior.Color = xlNone
  6. For i = 3 To Range("c3").End(xlDown).Row
  7.     d(Cells(i, 3).Value) = ""
  8. Next i
  9. k = d.keys
  10. For i = 0 To UBound(k)
  11.     For j = 3 + n To Range("c3").End(xlDown).Row
  12.         If k(i) = Cells(j, 3) Then
  13.             m = m + 1
  14.             n = n + 1
  15.         Else
  16.             Set Rng = Cells(j - m, 3).Resize(m, 4)
  17.             For Each Cell In Rng.Range(Cells(1, 4), Cells(Rng.Rows.Count, 4))
  18.                 If CDate(Split(Cell.Value, " ")(0)) = Date Then
  19.                     found = True
  20.                     d1(Split(Cell.Value, " ")(0)) = ""
  21.                 Else
  22.                     d1(Split(Cell.Value, " ")(0)) = ""
  23.                 End If
  24.             Next Cell
  25.                 k1 = d1.keys
  26.             Select Case d1.Count
  27.                 Case 1
  28.                     If CDate(k1(0)) = Date Then
  29.                     Rng.Interior.Color = 255
  30.                     End If
  31.                 Case 2
  32.                     If found = True Then
  33.                         For ii = 1 To Rng.Rows.Count
  34.                             If CDate(Split(Rng.Cells(ii, 4), " ")(0)) <> Date Then
  35.                                 Rng.Cells(ii, 1).Resize(1, 4).Interior.Color = 16711935
  36.                             End If
  37.                         Next ii
  38.                     End If
  39.                 Case Else
  40.                     If found = True Then
  41.                         For ii = 1 To Rng.Rows.Count
  42.                             If CDate(Split(Rng.Cells(ii, 4), " ")(0)) = Date Then
  43.                                 Rng.Cells(ii, 1).Resize(1, 4).Interior.Color = 255
  44.                             End If
  45.                         Next ii
  46.                     End If
  47.             End Select
  48.             m = 0
  49.             found = False
  50.             d1.RemoveAll
  51.             Exit For
  52.         End If
  53.     Next j
  54. Next i
  55. If Range("a2") <> "" Then
  56. Set Rng = Range("c3:c" & Cells(Rows.Count, 3).End(xlUp).Row)
  57.     For i = 1 To Rng.Rows.Count
  58.        If Rng.Cells(i) = Range("a2") Then
  59.        Rng.Resize(i, 4).Interior.Color = xlNone
  60.        End If
  61.     Next i
  62. End If
  63. End Sub
½Æ»s¥N½X
¦^´_ 1# RCRG

TOP

¦^´_ 2# ¸­°ê¬w

½Ð°Ý§Ú§â±zªºVBA¶K¦b¼Ò²Õ«á°õ¦æ¡A¦ý¦ü¥G¤£¦æ©O? ¬O§Ú¤âªk¦³¿ù»~¶Ü?



TOP

´ú¸Õ¸ê®Æ&#153219;¨S¦³·í¤Ñ¤é´Á¡A©Ò¥H¤£·|¶ñ¥RÃC¦â
½Ð¦Û¦æ¿é¤J·í¤Ñ¤é´Á¡A¦A°õ¦æµ{¦¡

TOP

¦^´_ 4# ¸­°ê¬w

®¦®¦¡A¦³¤F¡I
©Ò¥HC1Äæ¤@©w­n¬O "¯uªº" ¤µ¤Ñ¤é´Á¡AVBA¤~·|IJµo¶Ü? ¦pªG¬O¿é¤J¨ä¥L¤é´Á¨Ó "°²³]" ¬°¤µ¤Ñ¡A³o¼Ë´N¤£¦æ¶Ü?
¹ï¤FC1³oÄæ¦ì§Ú·Q¥ÎÂê©w§â¥¦«OÅ@°_¨Ó¡A©È¤H®a¥h­×§ï¨ì¡A¦ý¤@Âê©wVBA¦n¹³´N¶]¤£¤F¤F¡A¯àÀ°¸Ñ¨M¶Ü?

¥t¥~ "¿z¿ï¨Ò¥~®Æ¸¹" ¦n¹³¦³ÂI°ÝÃD¡A§Ú¦bAÄæ¶ñ¤J­n©¿²¤ªº®Æ¸¹¡A¦ý¨ä¥L®Æ¸¹¤]¸òµÛ¨ü¼vÅT¦Ó¤£¨£¤F¡I±ß¤W§Ú¦A§â¹Ï¤ù¶K¤W¨Ó¡F

³Ì«á§Úªº­ì°ÝÃD·Q­n¦A°µÂI­×§ï¡A¤£ª¾¥i¤£¥i¥H¡A¦p¤U¬õ¦â¦r³¡¤À

°ÝÃD¸Ô²Ó¤º®e
CÄæ(C3¶}©l)¦P¤@ºØ®Æ¸¹¸Ì¡A¹ïÀ³FÄæ­Y¥u¦³¤µ¤Ñ¤é´Á(©Î¤µ¤Ñ¥H«áªº¤é´Á)¡A«h¶ñº¡¬õ¦â¡F
¹ïÀ³FÄæ­Y "¥u¦³" ¤µ¤Ñ(©Î¤µ¤Ñ¥H«á¤é´Á)»P¥ô¤@¤Ñ¡A¨âºØ¤é´Á¡A«h¶ñº¡¯»¬õ¦â(±N¥ô¤@¤Ñ¤é´Á¶ñº¡¯»¬õ¦â§Y¥i)¡F

¤Ï¥¿´N¬O¤µ¤Ñ¥H«á¤é´Á(§t¤µ¤Ñ)¡A³£·í¦¨¬O¤µ¤Ñ´N¹ï¤F¡A±ß¤W§Ú¤]·|¤@°_ªþ²§°ÊÀɤW¨Ó¡F

¦b¦¹¤]¥ýÁÂÁ¸­¤j¤F¡I

TOP

¦^´_ 5# RCRG
§Ú§¹¥þ¨S¦³¦Ò¼{¨ìC1Àx¦s®æ,C1¦³¥ô¦óÅܰʬO¤£·|¼vÅT¨ìµ{¦¡ªº
¦³­n°µ­×§ïªº³¡¤À,½ÐÀHªþ¥ó¤W¼ÒÀÀ§A­nªºµ²ªG,¥ú¦r­±¤W»¡©ú,¦³
®É¤£¤@©w¨C­Ó¤H³£¯à©ú¥Õ§A¯u¥¿ªº»Ý¨D,©Î¦³®É§O¤H·|»~¸Ñ§Aªº恴«ä

TOP

¦^´_ 6# ¸­°ê¬w

²§±`1
¦p¤U¹Ï¡A³oÃä¬O¤£¸Ó¥X²{¤Ï¬õªº¡A¦]¬°¥u¦³"¤µ¤Ñ"¤é´Á¤~»Ý¤Ï¬õ¡A¦ý¸Ó®Æ¸¹¬O¦³¦hºØ¤é´Áªº¡C

TOP

¦^´_ 6# ¸­°ê¬w

²§±`2
¦p¤U¹Ï¡A¦bAÄæ "¨Ò¥~¿z¿ï®Æ¸¹" ³B¡A¿é¤J¸Ó®Æ¸¹¡AÀ³¸Ó¬O·|©¿²¤©Ò¦³±ø¥ó¦Ó¤£¤Ï¬õ©Î¤Ï¯»¬õ¡A¦ý¬O¸Óµ§«o¤Ï¯»¬õ¦â¤F
   

TOP

¦^´_ 6# ¸­°ê¬w
¦^´_  ¸­°ê¬w


®¦®¦¡A¦³¤F¡I
©Ò¥HC1Äæ¤@©w­n¬O "¯uªº" ¤µ¤Ñ¤é´Á¡AVBA¤~·|IJµo¶Ü? ¦pªG¬O¿é¤J¨ä¥L¤é´Á¨Ó ...
RCRG µoªí©ó 2016-11-18 10:48



¥t¥~¡A§Ú·Q§ó°Êªº­ì°ÝÃD¤º®e¡A¦b¦¹ªþ¤W¹Ï¤ù»PÀɮסA¦p¤U¡F
   ²§°Ê°ÝÃD¸Ô²Ó¤º®e       
CÄæ(C3¶}©l)¦P¤@ºØ®Æ¸¹¸Ì¡A¹ïÀ³FÄæ­Y"¥u¦³" ²{¦b¤§«á®É¶¡ "§YC1Ä檺=NOW()" ªº¤é´Á(³Ì¤p®É¶¡³æ¦ì·|¨ì¤À¬í)¡A«h¶ñº¡¬õ¦â¡F       
¹ïÀ³FÄæ­Y "¥u¦³" ²{¦b¤§«á®É¶¡»P²{¦b¤§«e®É¶¡¡A¦@¨âºØ¤é´Á ©Î "¥u¦³" ¦PºØ¤µ¤Ñ¤é´Á¦ý¨â­Ó²{¦b®É¶¡«e«á®É¶¡ÂI¡A«h¶ñº¡¯»¬õ¦â¡F       



²§°Ê«áªþ¥ó
²§°Êª©_¦p¦ó§Q¥ÎVBA«öÁä¡A±N«ü©w¤é´Á¶ñº¡ÃC¦â.rar (16.47 KB)

TOP

³W«h¬Ý°_¨Ó²V¶Ã, ¤j¬ù¼g¤@¤U, ²´·ú¤w¨ü¤£¤F, ­YÁÙ¦³»~®t, µ¥¨ä¥L¤j¤j¨Ó§a!
  1. Sub ¶ñ¦â()
  2. Dim xDic, xR As Range, TR, CC%
  3. If Not IsDate([C1]) Then MsgBox "¤é´Á®É¶¡¥¼¿é¤J! ": Exit Sub
  4. Set xDic = CreateObject("Scripting.Dictionary")
  5. For Each xR In Range([A1], [A65536].End(xlUp))
  6.     If xR.Row > 1 And xR <> "" Then xDic(xR.Value) = Array(99, 0, 0) '¨Ò¥~®Æ¸¹,¥H99¬°ÃѧO½X
  7. Next

  8. For Each xR In Range([C3], [C65536].End(xlUp))
  9.     If xR = "" Or Not IsDate(xR(1, 4)) Then GoTo 101 'µL®Æ¸¹©Î«D¤é´Á,²¤¹L
  10.     TR = xDic(xR.Value) '¨ú¥X¦r¨åÀÉITEM
  11.     If Not IsArray(TR) Then TR = Array(0, 0, 0) '­º¦¸¤J¦r¨åªÌ, ©ñ¤J¹w³]°}¦C
  12.     If TR(0) = 99 Then GoTo 101 'ÃѧO½X¬°99, ªí¥Ü¬°¨Ò¥~, ©Î¤£²Å³W«h, ²¤¹L
  13.     If xR(1, 4) > [C1] And TR(1) = 0 Then TR(0) = TR(0) + 10: TR(1) = 1 '¤j¤_C1, ¥[10¬°ÃѧO½X
  14.     If xR(1, 4) < [C1] Then '¤p¤_C1®É
  15.        If TR(2) = 0 Then TR(0) = TR(0) + 1: TR(2) = Int(xR(1, 4)) '°}¦C²Ä3­Ó­Y¬°0, ªí¥Ü¬°²Ä1­Ó¤é´Á,¶ñ¤J¤é´Á, ÃѧO½X¥[1
  16.        If Int(xR(1, 4)) <> TR(2) Then TR(0) = 99 '­Y¤é´Á¤£¬Û¦P, ªí¥Ü¤p¤_C1¤é´Á¶W¹L2­Ó,¥H99¬°ÃѧO½X
  17.     End If
  18.     xDic(xR.Value) = TR
  19. 101: Next

  20. For Each xR In Range([C3], [C65536].End(xlUp))
  21.     If xR = "" Or Not IsDate(xR(1, 4)) Then GoTo 102
  22.     TR = xDic(xR.Value): CC = 0
  23.     If TR(0) = 10 Then CC = 3 '¥u¦³¤j¤_C1¤é´Á, ÃѧO½X=10
  24.     If TR(0) = 11 And xR(1, 4) < [C1] Then CC = 7 '¦³¤j¤_C1¤é´Á, ¥B¤p¤_C1¤é´Á¥u¦³¤@­Ó, ÃѧO½X=10+1
  25.     If CC > 0 Then xR.Resize(1, 4).Interior.ColorIndex = CC
  26. 102: Next
  27. End Sub
½Æ»s¥N½X
Xl0000012.rar (15.7 KB)

TOP

        ÀR«ä¦Û¦b : ¤p¨Æ¤£°µ¡B¤j¨ÆÃø¦¨¡C
ªð¦^¦Cªí ¤W¤@¥DÃD