Excel t:=CDate（strdate），后：=ActiveCell，LookIn:=xlFormulas_ ，LookAt:=xlPart，SearchOrder:=xlByRows，SearchDirection:=xlNext_ MatchCase:=Fa

t:=CDate（strdate），后：=ActiveCell，LookIn:=xlFormulas_ ，LookAt:=xlPart，SearchOrder:=xlByRows，SearchDirection:=xlNext_ MatchCase:=False，SearchFormat:=False） 如果结束 如果sel为Nothing=False，则 作为整数的Dim col col=CInt（选择列） Selection.CurrentRegion.Select 单元格（CInt（rwrow.Row），列）。选择 Selection.Offset（0，0）.调整大小（Selection.Rows.Count，Selection.Columns.Count+diff）.选择 有选择。内饰 .Color=getcolor（CStr（单元）） 如果是凌晨12:00:00，那么 .TintAndShade=-0.249977111117893 .PatternTintAndShade=0.399975585192419 其他的 .TintAndShade=0.399975585192419 .PatternTintAndShade=0.399975585192419 如果结束 以 如果结束 下一个 '************* 范围（“A8”）。选择 端接头

---

另外，水平列中的3,2,1表示过去的几天，这些天本质上是延迟，4,5,6,7,8,9是一周中当前/未来的几天。如果您感兴趣，黑暗是已经开始的，光明尚未开始。

Sub One_Macro_To_Rule_Them_All()

'

'This clears the WOP sheet for formatting

    Sheets("WOP").Select
    Range("A8").Select
    Selection.CurrentRegion.Select
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1, _
    Selection.Columns.Count).Select

    Selection.ClearContents
    Cells.Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Cells(3, 2) = "Date : " & Format(Date, "dd/mm/yyyy")



 '**************

'Copy the data to the WOP Sheet

    Sheets("Data").Select

        Rows("1:1").Select
    Range( _
        "Table_FromMyServer_view_ForwardJobsLive_WOP[[#Headers],[Job No]]") _
        .Activate
    Range("B2").Select
    Selection.CurrentRegion.Select
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1, _
   Selection.Columns.Count - 1).Select




    Selection.Copy
        Sheets("WOP").Select
        Range("A8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      Range("A8").Select
      Cells(2, 2) = "Works Order Priority Sheet - " & Cells(8, 1)
    Selection.CurrentRegion.Select
    Selection.Offset(0, 6).Resize(Selection.Rows.Count, _
   Selection.Columns.Count - 6).Select

    curdate = Format(Date, "dd/mm/yyyy")
    Dim dt  As String
     dt = CStr(curdate)

     'find the start of the date range

        Range("A8").Select
    Selection.CurrentRegion.Select
    Selection.Offset(0, 6).Resize(Selection.Rows.Count, _
   Selection.Columns.Count - 6).Select
    Dim rngetosearch As Range
    Set rngetosearch = Selection

 rngetosearch.Find(What:="EARLIER", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Select
        Selection.Offset(0, 1).Resize(Selection.Rows.Count, Selection.Columns.Count + 1).Select

        dterangestart = ActiveCell



   '*********





'*************

'Format todays column as yellow
    Range("A8").Select
    Selection.CurrentRegion.Select
    Selection.Offset(0, 6).Resize(Selection.Rows.Count, _
    Selection.Columns.Count - 6).Select

Dim sel As Range
Dim rangetosearch As Range
Set rangetosearch = Selection
Dim strdate As String

strdate = Date

    strdate = Format(strdate, "Short Date")

Set sel = rangetosearch.Find(What:=CDate(strdate), After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

  If sel Is Nothing = False Then
    sel.Activate
  End If


         ActiveSheet.Range(sel.Cells.Address, ActiveSheet.Range(sel.Cells.Address).End(xlDown)).Select


    With Selection.Interior
        .Color = 65535
    End With
    '***************
    'Cycle Through the rows and change the blocks
    Sheets("WOP").Select
    Selection.CurrentRegion.Select

        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1, _
   Selection.Columns.Count - 0).Select

    Dim strtdte As Date
    Dim enddte As Date
    Dim actdte As Date
    Dim diff As Integer
    Dim selrnge As Range
   Set selrnge = Selection


    For Each rwrow In selrnge.Rows
        strtdte = rwrow.Cells(5)
        enddte = rwrow.Cells(7)
        actdte = rwrow.Cells(6)
        cell = rwrow.Cells(1)

        If strtdte < dterangestart Then
            'strtdte = dterangestart
            diff = DateDiff("d", dterangestart, enddte) + 1

        Else
        diff = DateDiff("d", strtdte, enddte)
        End If



        strdate = strtdte
        strdate = Format(strdate, "Short Date")

    Range("A8").Select
    Selection.CurrentRegion.Select
    Selection.Offset(0, 6).Resize(Selection.Rows.Count, _
   Selection.Columns.Count - 6).Select

    Set rngetosearch = Selection
    If strtdte < dterangestart Then
    Set sel = rngetosearch.Find(What:="EARLIER", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    Else
Set sel = rngetosearch.Find(What:=CDate(strdate), After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
  End If
  If sel Is Nothing = False Then
  Dim col As Integer
  col = CInt(sel.Column)

   Selection.CurrentRegion.Select
    ActiveSheet.Cells(CInt(rwrow.Row), col).Select

    Selection.Offset(0, 0).Resize(Selection.Rows.Count, Selection.Columns.Count + diff).Select
    With Selection.Interior
    .Color = getcolor(CStr(cell))
        If actdte <> #12:00:00 AM# Then
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0.399975585192419
         Else
         .TintAndShade = 0.399975585192419
         .PatternTintAndShade = 0.399975585192419
         End If
    End With
  End If

Next


    '*************
   Range("A8").Select

End Sub