Question

我需要一些帮助。我相信VBA是解决此问题的唯一方法，但我可能错了。

在工作簿的Sheet1中，我有两列包含不同的项目。例如，在B列和F列中包含不同的设备项目，并在数量旁边带有空白。它用作检查清单。在页面顶部的Sheet1上，还为各个“框”（例如：Box 1，Box 2，Box 3等）选择了一些条件格式的复选框。

在Sheet2上，如上所述，为每个框命名的表都是不同的，并且表中的项也不同。这些项目可能与Sheet1的B＆F列中的项目相同或不同。

目的：我希望学习编写代码，以说明在选择工作表1上各个框旁边的条件格式复选框时，如果它与工作表2中所选框中的任何项目匹配，它将突出显示工作表1上的项目。

****我用下面的代码更新了我的问题。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells As Range

' In order to run code on sheet without a button or enabling in a module
Set KeyCells = Range("A2")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is 
Nothing Then

' Display a message when one of the designated cells has been changed.


Dim i, j As Integer
Dim box As String
Dim c As Range 'Define two ranges so that we can loop through both sheets to 
check the boxes
Dim d As Range
Sheets(1).Range("B11:B30, F11:F30").Font.ColorIndex = 0 'Remove the cell styles to apply new ones
box = Sheets(1).Cells(2, 1) 'This refers to the checkbox -  **QUESTION:How to have "multiple" check boxes to select from and will  run the same code?**
For i = 1 To 10 'Loop to find the checked box in sheet2
    If Sheets(2).Cells(1, i) = box Then 'Check for checked box
        For Each c In Sheets(2).Range(Sheets(2).Cells(2, i), Sheets(2).Cells(6, i))
            For Each d In Sheets(1).Range("B11:B30, F11:F30")
                If c = d Then
                    Sheets(1).Cells(d.Row, d.Column).Font.ColorIndex = 3 'changes matching item to red font
                End If
            Next d
        Next c
    End If
Next i
End If
End Sub

Answer 1

根据我对您的问题的理解，我编写了代码以设置单元格颜色。我已经给出了注释以及代码。

Sub format()
Dim i As Integer
Dim box As String
Dim c As Range 'Define two ranges so that we can loop through both sheets to check the boxes
Dim d As Range
Sheets(1).Range(Cells(4, 1), Cells(50, 50)).Interior.ColorIndex = xlNone 'Remove the cell styles to apply new ones
box = Sheets(1).Cells(1, 1) 'This refers to the checkbox
For i = 1 To 10 'Loop to find the checked box in sheet2
    If Sheets(2).Cells(1, i) = box Then 'Check for checked box
        For Each c In Sheets(2).Range(Sheets(2).Cells(2, i), Sheets(2).Cells(20, i))
            For Each d In Sheets(1).Range(Cells(4, 2), Cells(21, 21))
                If c = d Then
                    Sheets(1).Cells(d.Row, d.Column).Interior.ColorIndex = 6 'If true give yellow colour
                End If
            Next d
        Next c
    End If
Next i
End Sub

这是我使用Excel Sheet

的Excel工作表

Answer 2

请参阅以下有关我到目前为止的代码。这是我上面收到的内容的一种变体。我已经在第13行上发布了问题。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells As Range

' In order to run code on sheet without a button or enabling in a module
Set KeyCells = Range("A2")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is 
Nothing Then

' Display a message when one of the designated cells has been changed.


Dim i, j As Integer
Dim box As String
Dim c As Range 'Define two ranges so that we can loop through both sheets to check the boxes
Dim d As Range
Sheets(1).Range("B11:B30, F11:F30").Font.ColorIndex = 0 'Remove the cell styles to apply new ones
box = Sheets(1).Cells(2, 1) 'This refers to the checkbox -  **QUESTION: How to have "multiple" check boxes to select from and will  run the same code?**
For i = 1 To 10 'Loop to find the checked box in sheet2
    If Sheets(2).Cells(1, i) = box Then 'Check for checked box
        For Each c In Sheets(2).Range(Sheets(2).Cells(2, i), Sheets(2).Cells(6, i))
            For Each d In Sheets(1).Range("B11:B30, F11:F30")
                If c = d Then
                    Sheets(1).Cells(d.Row, d.Column).Font.ColorIndex = 3 'changes matching item to red font
                End If
            Next d
        Next c
    End If
Next i
End If
End Sub

Sheet 1 Check boxes-我有条件格式的复选框，可以更改。它们基于数据验证列表0.1以更改填充。但是我可能不得不更改它。

我已经回答了我自己的问题。基本上，您可以只具有多个字符串box1，box2等，并为每个字符串编写相同的代码。不确定这样做是否可行，但是否可行。

Excel，VBA，条件格式

2 个答案: