Private Sub Worksheet_Activate()
    '--------------------------------------------------------------------------------
    ' Right Click On "Sheet1" Tab and
    ' Select "View Code" and paste the following code
    '--------------------------------------------------------------------------------
    
    Dim FreezVal As Long, LastRow As Long, x As Long
    Dim FreezOnDate As Date, rowItemDate As Date
    Dim ws As Workbook
    
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    
    Set ws = ThisWorkbook
    Set sh1 = ws.Sheets("Sheet1")
    Set sh2 = ws.Sheets("Sheet2")
    
    FreezOnDate = CDate(sh2.Range("E7").Value)  'refer to Sheet2!E7 value
    LastRow = sh1.Range("A3").End(xlDown).Row   'find last row of data in Sheet1
    
      For x = 3 To LastRow   ''In Sheet1 loop till last row and compare value in cell E7 in Sheet2
      
        rowItemDate = CDate(sh1.Range("A" & x).Value)
        FreezVal = sh1.Range("E" & x).Value
        
        sh1.Range("D" & x).Value = "=" & sh1.Range("c" & x).Address & "/" & sh1.Range("B" & x).Address
          
          If rowItemDate = FreezOnDate Then
          
            sh1.Range("D" & x).Value = Range("D" & x).Value
            sh1.Range("A" & x, "D" & x).Font.Color = vbBlue ''freezed row highlighted
          
          Else
          
           sh1.Range("A" & x, "D" & x).Font.Color = vbBlack
           
          End If
        
      Next x
    End Sub

字符串