ªð¦^¦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)

¦^´_ 10# ­ã´£³¡ªL


    ÁÂÁ½׾Â,ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß«e½úªº¤è®×,¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É

°õ¦æ«e:


°õ¦æµ²ªG:



Sub ¶ñ¦â()
Dim xDic, xR As Range, TR, CC%
'¡ô«Å§iÅܼÆ
If Not IsDate([C1]) Then MsgBox "¤é´Á®É¶¡¥¼¿é¤J! ": Exit Sub
'¡ôÀË´ú[C1]»Ý­n¿é¤J¥¿½T¤é´Á®É¶¡
Set xDic = CreateObject("Scripting.Dictionary")
'¡ô¥OxDic¬O¦r¨å
For Each xR In Range([A1], [A65536].End(xlUp))
'¡ô³]³v¶µ°j°é!¥OxR¬OAÄ檺Àx¦s®æ
    If xR.Row > 1 And xR <> "" Then xDic(xR.Value) = Array(99, 0, 0)
    '¡ô¨Ò¥~®Æ¸¹,¥H99¬°ÃѧO½X
    '¥HxRÀx¦s®æ­È¬°key,item¬O¤@ºû°}¦C,0¯Á¤Þ¸¹­È¬O99

Next
For Each xR In Range([C3], [C65536].End(xlUp))
'¡ô³]³v¶µ°j°é!¥OxR¬OCÄ檺Àx¦s®æ
    If xR = "" Or Not IsDate(xR(1, 4)) Then GoTo 101
    '¡ô¦pªGµL®Æ¸¹©Î«D¤é´Á,¸õ¨ì101¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
    TR = xDic(xR.Value)
    '¡ô¥OTRÅܼƬOxRÅܼƬdxDic¦r¨å¦^¶Çªºitem­È(¨ú¥X¦r¨åÀÉITEM)
    If Not IsArray(TR) Then TR = Array(0, 0, 0)
    '¡ô¦pªGTRÅܼÆÁÙ¤£¬O°}¦C!´N¥OTRÅܼƬO¤@ºû°}¦C(­º¦¸¤J¦r¨åªÌ, ©ñ¤J¹w³]°}¦C)
    If TR(0) = 99 Then GoTo 101
    '¡ô¦pªGÃѧO½X¬°99, ªí¥Ü¬°¨Ò¥~, ©Î¤£²Å³W«h,¸õ¨ì101¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
    If xR(1, 4) > [C1] And TR(1) = 0 Then TR(0) = TR(0) + 10: TR(1) = 1
    '¡ô¦pªGxRÀx¦s®æ(§t)¥k°¼²Ä4®æ¤j©ó[C1]Àx¦s®æ®É¶¡,¦Ó¥B1¯Á¤Þ¸¹TR°}¦C¬O0 !
    '´N¥O0¯Á¤Þ¸¹TR°}¦C­È²Ö¥[10(¬O0¥[10¬°ÃѧO½X),¥O1¯Á¤Þ¸¹TR°}¦C­È¬O1

    If xR(1, 4) < [C1] Then
    '¡ô¦pªG¤é´ÁÄæ­È¤p©ó[C1]­È®É?
       If TR(2) = 0 Then TR(0) = TR(0) + 1: TR(2) = Int(xR(1, 4))
       '¡ôTR°}¦C2¯Á¤Þ¸¹­È­Y¬°0, ªí¥Ü¬°²Ä1­Ó¤é´Á,¶ñ¤J¤é´Á, ÃѧO½X¥[1
       If Int(xR(1, 4)) <> TR(2) Then TR(0) = 99
       '¡ô­Y¤é´Á¤£¬Û¦P, ªí¥Ü¤p¤_C1¤é´Á¶W¹L2­Ó,¥H99¬°ÃѧO½X
    End If
    xDic(xR.Value) = TR
    '¡ô¥HxRÀx¦s®æ­È·íkey,item¬OTRÅܼÆ(¤@ºû°}¦C),¯Ç¤JxDic¦r¨å
101: Next
For Each xR In Range([C3], [C65536].End(xlUp))
'¡ô³]³v¶µ°j°é!¥OxR¬OCÄ檺Àx¦s®æ
    If xR = "" Or Not IsDate(xR(1, 4)) Then GoTo 102
    '¡ô¦pªGµL®Æ¸¹©Î«D¤é´Á,¸õ¨ì102¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
    TR = xDic(xR.Value): CC = 0
    '¡ô¥OTRÅܼƲ±¥X xRÀx¦s®æ­È¦bxDic¦r¨å¸Ìªºitem(¤@ºû°}¦C):¥OCCÅܼÆÂk¹s
    If TR(0) = 10 Then CC = 3
    '¡ô¦pªG¥u¦³¤j¤_C1¤é´Á ,0¯Á¤Þ¸¹TR°}¦C­È¬O10(ÃѧO½X = 10),´N¥OCCÅܼƬO3
    If TR(0) = 11 And xR(1, 4) < [C1] Then CC = 7
    '¡ô¦pªG¦³¤j¤_C1¤é´Á, ¥B¤p¤_C1¤é´Á¥u¦³¤@­Ó, ÃѧO½X=10+1),´N¥OCCÅܼƬO7
    If CC > 0 Then xR.Resize(1, 4).Interior.ColorIndex = CC
    '¡ô¤W©³¦â
102: Next
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 16# RCRG


xR(1, 4) CÄæ¥k²Ä4®æ, ¬°FÄæ, Ãþ±À~~~

TOP

¦^´_ 13# ­ã´£³¡ªL

¤µ¤Ñ¶XµÛªÅÀɸեΤF¤@¤U­ã¤jªºª©¥»¡A§¹¥þ²Å¦X§Ú»Ý­nªº¡A¯uªº«ÜÁÂÁÂÀ°¤F¤j¦£¡F

·Q½Ð±Ð¤@¤U¡A§Ú§â¤é´Á¿ù¶K¨ìFÄæ¡A²{¦b·Q§ï¨ìGÄæ¡A½Ð°Ý­n¦p¦ó­×§ïVBA©O?

TOP

¦^´_ 14# RCRG

Selection.FormulaR1C1 = ""³o¦æ¤U­±¦A¥[
Selection.interior.color = xlnone

TOP

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


    ½Ð°Ý¤@¤U¡A¤U­±¬O¤@Áä²M°£VBA¡A¦ý¨S¿ìªk³s¶ñº¡ªºÃC¦â¤]«ì´_¦¨¥Õ¦â¡A
½Ð°Ý­n¦p¦ó¼g¤~¯à¤@Áä´N¨Ï½d³ò¤º«ì´_ªÅ¥Õ­ìª¬©O??

Sub ¤@Áä²MªÅ()
    Range("B3:U1000").Select
    Range("B3:U1000").Activate
    Selection.FormulaR1C1 = ""   
    Sheets("´ú¸Õ­¶").Select
    Range("B2").Select
    [B1] = ""
MsgBox "²M°£§¹¦¨¡I"
End Sub

TOP

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

¦^´_ 12# RCRG


¡ã¡ã·íµM¦pªGC1Äæ§Ú¯à°÷¥Î =NOW()¡A¾ã­Ó·Ç½T«×ªº®ÄªG·|¹ï§Ú§ó¦n¡A¦ý¥Ø«e¬Ý¨Ó¨â¦ì¤j¤jªºVBA§Ú¥u¯à¶ñ¤J=TODAY()¡@

µ{¦¡¬O¥Î¡@¤é+®É¶¡¡@¥h¤ñ¹ï«e«á¡A­n¤£­n¦A¦h¸Õ¡H¡H¡H
¦Ü¤Ö¤U¸ü½d¨ÒÀɬݧa¡I
¡@

TOP

¦^´_ 11# ¸­°ê¬w
¦^´_ 10# ­ã´£³¡ªL


ÁÂÁ¨â¦ì¤j¤jªº¦^µª¡A³o´N¬O§Ú·Q­nªº®ÄªG¡A©êºp§â°ÝÃDªí¹Fªº³o»ò¥O¤H¶O¸Ñ....XD
²³æ¨ÓÁ¿´N¬O¡A°²³]²{¦bªº®É¶¡ÂI¤§«á³£¬O "¬µ¼u"¡A¦Ó²{¦bªº®É¶¡ÂI¤§«e¨Cµ§³£¬O¬ÞµP¡A
¬ÞµP¶V¨Ó¶V¤Ö¡A¤Ö¨ì¤@©w¼Æ¶q¡A«K·|¥X²{"¯»¬õ¦â"´£¿ô§Ú¡F
·í¬ÞµP³£¨S¤F¡A¥u³Ñ¬µ¼u(²{¦b¥H«á®É¶¡ÂI)¡A´N·|¥X²{¬õ¦â´£¿ô§Ú¡F
¤£ª¾¹D³o¼ËÄ´³ë·|¤£·|«Ü©_©Ç...QQ

·íµM¦pªGC1Äæ§Ú¯à°÷¥Î =NOW()¡A¾ã­Ó·Ç½T«×ªº®ÄªG·|¹ï§Ú§ó¦n¡A¦ý¥Ø«e¬Ý¨Ó¨â¦ì¤j¤jªºVBA§Ú¥u¯à¶ñ¤J=TODAY()¡A
¯uªº«ÜÁÂÁ¸­¤j©M­ã¤j¸Ñµª¡A¨ü¥ÎµL½a¡A·P¿E¤£ºÉ¡I

TOP

¦^´_ 9# RCRG
¬Ý¬Ý³o¼Ë¥i¥H¶Ü
  1. Sub ex()
  2. Dim d, d1, rng() As Range, arr, i%, j%, rng1 As Range
  3. For i = 3 To Cells(Rows.Count, 3).End(xlUp).Row
  4. If Right(Cells(i, 3), 1) = ChrW(160) Then
  5. Cells(i, 3).Replace ChrW(160), ""
  6. End If
  7. Next i
  8. Set d = CreateObject("scripting.dictionary")
  9. Set d1 = CreateObject("scripting.dictionary")
  10. With Sheets("´ú¸Õ­¶")
  11. Set rng1 = .Range("a2:a" & .Cells(Rows.Count, 1).End(xlUp).Row)
  12. arr = .Range("c3:f" & .Cells(Rows.Count, 3).End(xlUp).Row)
  13. .Range("c3:f" & .Cells(Rows.Count, 3).End(xlUp).Row).Interior.Color = xlNone
  14.     For i = 1 To UBound(arr)
  15.         d(arr(i, 1)) = d(arr(i, 1)) + 1
  16.     Next i
  17.     ReDim rng(1 To d.Count)
  18.     t = d.items
  19.     For i = 1 To d.Count
  20.         k = k + t(i - 1)
  21.         Set rng(i) = .Range(.Cells(2 + k - t(i - 1) + 1, 3), .Cells(2 + k, 6))
  22.         If WorksheetFunction.CountIf(rng(i), ">" & .Range("c1")) = rng(i).Rows.Count And _
  23.             WorksheetFunction.CountIf(rng1, rng(i).Cells(1, 1)) = 0 Then
  24.             rng(i).Interior.Color = 255
  25.         ElseIf WorksheetFunction.CountIf(rng(i), ">" & .Range("c1")) < rng(i).Rows.Count And _
  26.                WorksheetFunction.CountIf(rng(i), ">" & .Range("c1")) <> 0 Then
  27.             For j = 1 To rng(i).Rows.Count
  28.                 If rng(i).Cells(j, 4) < Range("c1") Then
  29.                     spr = Split(rng(i).Cells(j, 4), " ")(0)
  30.                     d1(spr) = d1(spr) + 1
  31.                 End If
  32.             Next j
  33.              k1 = d1.keys
  34.              If d1.Count = 1 Then
  35.                For j = 1 To rng(i).Rows.Count
  36.                  If rng(i).Cells(j, 4) < .Range("c1") And WorksheetFunction.CountIf(rng1, rng(i).Cells(1, 1)) = 0 Then
  37.                     rng(i).Rows(j).Interior.Color = 16711935
  38.                  End If
  39.                Next j
  40.              End If
  41.           End If
  42.         d1.RemoveAll
  43.     Next i
  44. End With
  45. End Sub
½Æ»s¥N½X

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 : ­ì½Ì§O¤H´N¬Oµ½«Ý¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD