Question

我遇到的问题是我在Excel中制作的待办事项列表。目前，我正在尝试创建VBA代码，只要更改单元格中的值，就会更新Cell Interior Fill Color。换句话说，列F包含项目的截止日期。如果该项目当天到期，则整行的颜色应为红色。如果该项目从那时起30天以上，它应该是绿色的，并且介于两者之间。待办事项列表应该是动态的。即用户可以随时添加新行。由于VBA无法知道最后一行数据的位置，因此我将代码设置为依赖于列表最左侧列中复选框的位置。我发布了一张图片，但我刚刚开始上映，所以我还没有这种能力。基本上，在第2行中有一个标题行，从列B开始有6列，转到G列，＆＃34;检查，状态，任务，注释，到期，剩余天数＆＃34;。

有12个参赛作品的列表。条目1-11工作正常，代表一行可能有11种不同的颜色。第12行从第11行拖放，包含所有功能和复选框。第12行在调用VBA时不会更新。

我的代码使用For Each循环遍历列表中的每个复选框，并根据截止日期更新颜色。对于大多数复选框，它工作正常，并且msgbox的位置始终表明它正在通过循环正常。但是，当我添加新行时，通过选择整行并在工作表中将其向下拖动，VBA代码仅停止识别新的复选框。除了新的框之外，它可以遍历所有框。我也附上了我的VBA代码。如果有人能告诉我如何修复无法识别（不受欢迎）的复选框，我会非常感激！

检查更新的代码此代码位于VBA的Worksheet1部分，而不是在其他模块中。

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.Volatile True
    Application.ScreenUpdating = False
    Call Checkbox_Due_Color
    Application.ScreenUpdating = True
End Sub

设置范围的代码并充当决策处理程序我认为问题出现在此代码的循环中。 MsgBox myCheckboxLoc.Address不会触发最后一个复选框。它位于第2单元。

Option Explicit

Sub Checkbox_Due_Color()
'===============================================================
'Determines how to update the color to indicate days left.
'===============================================================
    Application.Volatile True
    Dim myCheckbox As CheckBox
    Dim myCheckboxLoc As Range
    Dim myDaysLeft As Integer
    Dim myCheckboxName As String

    For Each myCheckbox In ActiveSheet.CheckBoxes
            Set myCheckboxLoc = Range(myCheckbox.TopLeftCell.Address & ":" & myCheckbox.TopLeftCell.Offset(0, 5).Address)
            MsgBox myCheckboxLoc.Address
            If IsEmpty(myCheckbox.TopLeftCell.Offset(0, 4)) = True Then
                'MsgBox "IF TRUE"
                myCheckboxLoc.Interior.ColorIndex = xlNone
            Else
                'MsgBox "IF False"
                myDaysLeft = myCheckbox.TopLeftCell.Offset(0, 4).Value - Date
                'MsgBox myDaysLeft
                Call Update_Color(myCheckboxLoc, myDaysLeft)
            End If
    Next myCheckbox
End Sub

确定要使用的颜色的代码此代码工作正常，为清晰起见而包含在内。也位于第2单元。

Sub Update_Color(myCheckboxLoc As Range, myDaysLeft As Integer)
'===============================================================
'Change background color of cell related to days left until due.
'===============================================================

    Select Case myDaysLeft
        Case Is <= 0
            myCheckboxLoc.Interior.Color = RGB(255, 0, 0)
        Case 1
            myCheckboxLoc.Interior.Color = RGB(255, 50, 0)
        Case 2
            myCheckboxLoc.Interior.Color = RGB(255, 100, 0)
        Case 3 To 4
            myCheckboxLoc.Interior.Color = RGB(255, 150, 0)
        Case 5 To 6
            myCheckboxLoc.Interior.Color = RGB(255, 200, 0)
        Case 7 To 9
            myCheckboxLoc.Interior.Color = RGB(255, 210, 0)
        Case 10 To 13
            myCheckboxLoc.Interior.Color = RGB(255, 230, 0)
        Case 14 To 20
            myCheckboxLoc.Interior.Color = RGB(255, 255, 0)
        Case 21 To 29
            myCheckboxLoc.Interior.Color = RGB(175, 255, 0)
        Case Else
            myCheckboxLoc.Interior.Color = RGB(0, 255, 0)
        End
    End Select

End Sub

Answer 1

您的代码在Update_Color子过程中出现问题。您不需要在“结束选择”之前输入“结束”。您的案例陈述应如下所示：

 Select Case myDaysLeft
    Case Is <= 0
        myCheckboxLoc.Interior.Color = RGB(255, 0, 0)
    Case 1
        myCheckboxLoc.Interior.Color = RGB(255, 50, 0)
    Case 2
        myCheckboxLoc.Interior.Color = RGB(255, 100, 0)
    Case 3 To 4
        myCheckboxLoc.Interior.Color = RGB(255, 150, 0)
    Case 5 To 6
        myCheckboxLoc.Interior.Color = RGB(255, 200, 0)
    Case 7 To 9
        myCheckboxLoc.Interior.Color = RGB(255, 210, 0)
    Case 10 To 13
        myCheckboxLoc.Interior.Color = RGB(255, 230, 0)
    Case 14 To 20
        myCheckboxLoc.Interior.Color = RGB(255, 255, 0)
    Case 21 To 29
        myCheckboxLoc.Interior.Color = RGB(175, 255, 0)
    Case Else
        myCheckboxLoc.Interior.Color = RGB(0, 255, 0)
End Select

我重新创建了您的工作表，删除该行后一切正常。我还建议您使用“Debug.print”而不是“MsgBox”进行调试。

您还说“因为VBA无法知道最后一行数据的位置，所以我将代码设置为依赖于列表最左侧列中复选框的位置。”那不太准确。您可以使用End属性来确定最后一行数据。像这样：

Sub getTaskRange()

  Dim cell As Range
  Dim taskRange As Range
  'Set the range object dynamically
  Set taskRange = ActiveSheet.Range(Cells(2, "d"), Cells(Rows.Count, "d").End(xlUp))

  'Print the contents of each cell to the immediate window
  For Each cell In taskRange
    Debug.Print cell.Value
  Next cell

End Sub

每个循环的Excel VBA跳过复选框

1 个答案: