根据日期更改值和颜色

Question

我一直在不知疲倦地寻找解决方案，并且已经接近我正在寻找的解决方案。我在某种程度上是 VBA 编码的初学者，并且一直在通过尝试寻找某些功能的代码来学习。

我有这个时间表并根据行中的一天 (F8:AJ8) 我希望它的整个列用黄色突出显示 (颜色索引 = 44) 如果它 = "Fri" 并更改它们的值 (交替单元格在每个行）从 10 到 0，但仅限于名为“Timesheetarea”（F8：AJ131）的范围，因为有时我必须添加行。

我在下面的代码中面临的问题是当按下命令按钮时，如果 F8 是星期五，那么所有 10 都被替换为“”，并且颜色被填充到单元格 F151（位于签名部分并且不在表格边框），如果 F8 为“Sat”，则所有“”变为 10，如果再次按下则变为 110、1110 等。

我正在尝试一列的代码，如果它有效，我将为从 F 到 AJ 的其余列修改它。

另请注意，不包含 31 天的月份，那一天 (31) 自动为“”，其列值将是“”，因此不会被添加。这是通过 F8 - AJ8 确定日期的公式 =IF(AJ7="","",TEXT(AJ7,"ddd"))

这是获取月份日期的公式 从单元格 G7 到 AJ7 =IF(F7="","",IF(MONTH(F7)MONTH(F7+1),"",F7+1))

F7 的公式是 =IF(F1="","",DATEVALUE("1"&F1))

这样，例如，如果 2 月是 28 天，则 28-2-21 之后的接下来 3 个单元格将为空白，并且它们的天数将显示为空白。

Sub fixFri()

Application.ScreenUpdating = False
Dim bottoma As Integer
Dim bottomB As Integer
 Dim bottomC As Integer
  Dim bottomD As Integer
   Dim bottomE As Integer
Dim bottomf As Integer
Dim bottomg As Integer
 Dim bottomh As Integer
  Dim bottomi As Integer
   Dim bottomj As Integer
    Dim bottomk As Integer
Dim bottoml As Integer
 Dim bottomm As Integer
  Dim bottomn As Integer
   Dim bottomo As Integer
    Dim bottomp As Integer
Dim bottomq As Integer
 Dim bottomr As Integer
  Dim bottoms As Integer
   Dim bottomt As Integer
  
Dim bottomu As Integer
Dim bottomv As Integer
 Dim bottomw As Integer
  Dim bottomx As Integer
   Dim bottomy As Integer
    Dim bottomz As Integer
Dim bottomaa As Integer
 Dim bottomab As Integer
  Dim bottomac As Integer
   Dim bottomad As Integer
   Dim bottomae As Integer
  
   
  
bottoma = Range("F" & Rows.Count).End(xlUp).Row
bottomB = Range("G" & Rows.Count).End(xlUp).Row
bottomC = Range("H" & Rows.Count).End(xlUp).Row
bottomD = Range("I" & Rows.Count).End(xlUp).Row
bottomE = Range("J" & Rows.Count).End(xlUp).Row


bottomf = Range("K" & Rows.Count).End(xlUp).Row
bottomg = Range("L" & Rows.Count).End(xlUp).Row
bottomh = Range("M" & Rows.Count).End(xlUp).Row
bottomi = Range("N" & Rows.Count).End(xlUp).Row
bottomj = Range("O" & Rows.Count).End(xlUp).Row


bottomk = Range("P" & Rows.Count).End(xlUp).Row
bottoml = Range("q" & Rows.Count).End(xlUp).Row
bottomm = Range("r" & Rows.Count).End(xlUp).Row
bottomn = Range("s" & Rows.Count).End(xlUp).Row
bottomo = Range("t" & Rows.Count).End(xlUp).Row


bottomp = Range("u" & Rows.Count).End(xlUp).Row
bottomq = Range("v" & Rows.Count).End(xlUp).Row
bottomr = Range("w" & Rows.Count).End(xlUp).Row
bottoms = Range("x" & Rows.Count).End(xlUp).Row
bottomt = Range("y" & Rows.Count).End(xlUp).Row

bottomu = Range("Z" & Rows.Count).End(xlUp).Row
bottomv = Range("aa" & Rows.Count).End(xlUp).Row
bottomw = Range("ab" & Rows.Count).End(xlUp).Row
bottomx = Range("ac" & Rows.Count).End(xlUp).Row
bottomy = Range("ad" & Rows.Count).End(xlUp).Row


 bottomz = Range("ae" & Rows.Count).End(xlUp).Row
bottomaa = Range("af" & Rows.Count).End(xlUp).Row
bottomab = Range("ag" & Rows.Count).End(xlUp).Row
bottomac = Range("ah" & Rows.Count).End(xlUp).Row
bottomad = Range("ai" & Rows.Count).End(xlUp).Row
bottomae = Range("aj" & Rows.Count).End(xlUp).Row



Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range

Dim rng10 As Range
Dim rng11 As Range
Dim rng12 As Range
Dim rng13 As Range
Dim rng14 As Range
Dim rng15 As Range
Dim rng16 As Range
Dim rng17 As Range
Dim rng18 As Range
Dim rng19 As Range
Dim rng20 As Range
Dim rng21 As Range
Dim rng22 As Range
Dim rng23 As Range
Dim rng24 As Range
Dim rng25 As Range
Dim rng26 As Range
Dim rng27 As Range
Dim rng28 As Range
Dim rng29 As Range
   Dim rng30 As Range
Dim rng31 As Range


 Dim Lday1 As String
 Dim Lday2 As String
 Dim Lday3 As String
 Dim Lday4 As String
 Dim Lday5 As String
 Dim Lday6 As String
    Dim Lday7 As String
    Dim Lday8 As String
    Dim Lday9 As String
    Dim Lday10 As String
     Dim Lday11 As String
    Dim Lday12 As String
    Dim Lday13 As String
    Dim Lday14 As String
    Dim Lday15 As String
    Dim Lday16 As String
    Dim Lday17 As String
    Dim Lday18 As String
    Dim Lday19 As String
    Dim Lday20 As String
     Dim Lday21 As String
    Dim Lday22 As String
    Dim Lday23 As String
    Dim Lday24 As String
    Dim Lday25 As String
    Dim Lday26 As String
    Dim Lday27 As String
    Dim Lday28 As String
    Dim Lday29 As String
    Dim Lday30 As String
    Dim Lday31 As String

    Dim Ldayvalue As Integer
 Lday1 = Range("F8").Value


For Each rng1 In Range("F8:F" & bottoma)
If Lday1 = "Fri" Then
    rng1.Value = Replace(rng1, 10#, 0#)
    rng1.Interior.ColorIndex = 44


 ElseIf Lday1 = "Sat" Then
 rng1.Value = Replace(rng1, 0#, 10#)
 rng1.Interior.ColorIndex = 2

 ElseIf Lday1 = "Sun" Then
 rng1.Value = Replace(rng1, 0#, 10#)
 rng1.Interior.ColorIndex = 2

 ElseIf Lday1 = "Mon" Then
 rng1.Value = Replace(rng1, 0#, 10#)
 rng1.Interior.ColorIndex = 2

 ElseIf Lday1 = "Tue" Then
 rng1.Value = Replace(rng1, 0#, 10#)
 rng1.Interior.ColorIndex = 2

 ElseIf Lday1 = "Wed" Then
 rng1.Value = Replace(rng1, 0#, 10#)
 rng1.Interior.ColorIndex = 2

 ElseIf Lday1 = "Thu" Then
 rng1.Value = Replace(rng1, 0#, 10#)
 rng1.Interior.ColorIndex = 2


 ElseIf Lday1 = "" Then
 rng1.Value = Replace(rng1, 10#, 0#)
 rng1.Value = Replace(rng1, 0#, 0#)
 rng1.Interior.ColorIndex = 2

 End If
 Next rng1

 End Sub

Answer 1

无需向下扫描，可以使用Range.Replace

Sub fixFri()

    Const TIMESHEET = "F8:AJ131"
   
    Dim wb As Workbook, ws As Worksheet
    Dim LastRow As Long, c As Range, d As String
   
    Set wb = ThisWorkbook
    Set ws = wb.ActiveSheet
   
    ' scan across timesheet columns
    For Each c In ws.Range(TIMESHEET).Columns
        d = c.Cells(1) ' day
        If d = "" Then
            ' skip
        ElseIf d = "Fri" Then
            c.Interior.Color = RGB(255, 255, 0) ' yellow
            c.Replace 10, 0, lookat:=xlWhole
        Else
            c.Interior.Pattern = xlNone 'no color
            c.Replace 0, 10, lookat:=xlWhole
        End If
        
    Next
    MsgBox "Done", vbInformation

End Sub