¸­°ê¬w

¦^´_ 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

RCRG

¦^´_ 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

­ã´£³¡ªL

¦^´_ 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
¡@

RCRG

¦^´_ 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

¸­°ê¬w

¦^´_ 14# RCRG

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

RCRG

¦^´_ 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?

­ã´£³¡ªL

¦^´_ 16# RCRG


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

Andy2483

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


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

°õ¦æ«e:

¤U¸ü (227.96 KB)

2023-5-10 09:07

°õ¦æµ²ªG:

¤U¸ü (217.11 KB)

2023-5-10 09:07

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