如何解决如果值与列中其他工作表的值匹配,则更改单元格的颜色
这是代码。我有一个日历,日历的日期为B4:H9。如果这些日期在列表中(列,在不同的工作表上),我想更改单元格的颜色。 如果工作表中有许多不同的日期,运行起来可能会很繁琐,但这没关系。
我在这里做错了什么?尝试不同的操作时,它会不断为我提供不同的错误代码。
Sub check_Click()
Dim area As Range
Dim item1 As Range
Dim item2 As Range
Dim sheet As Worksheet
Dim columnlist As Range
sheet = Range("E2").Value
area = Range("B4:H9")
columnlist = Worksheets(sheet).Range("A2:A" & Rows.Count)
For Each item1 In area
For Each item2 In columnlist
If item1.Value = item2.Value Then
item1.Interior.ColorIndex = RGB(255,255,0)
End If
Next item2
Next item1
End Sub
解决方法
如SuperSymmetry所述,定义对象(例如范围,图纸)时,您需要使用Set
关键字。我将不作解释。但是我想提的几件事...
- 尝试提供有意义的变量名,以便您了解它们的用途。
- 使用对象,以便您的代码知道您要引用的工作表,范围。
- 不需要第二个循环。使用.Find搜索您的数据。会更快
- 要设置RGB,您需要
.Color
而不是.ColorIndex
这是您要尝试的吗? (未经测试)
Option Explicit
Sub Check_Click()
Dim rngData As Range
Dim rngReference As Range
Dim aCell As Range
Dim matchedCell As Range
Dim ws As Worksheet
Dim lastRow As Long
Dim worksheetName As String
'~~> Change the sheet name accordingly
worksheetName = ThisWorkbook.Sheets("Sheet1").Range("E2").Value
Set ws = ThisWorkbook.Sheets(worksheetName)
With ws
'~~> Find the last row in Col A
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Set your range
Set rngData = .Range("B4:H9")
Set rngReference = .Range("A2:A" & lastRow)
'~~> Loop through your data and use .Find to check if the date is present
For Each aCell In rngData
Set matchedCell = rngReference.Find(What:=aCell.Value,_
LookIn:=xlValues,_
LookAt:=xlWhole,_
SearchOrder:=xlByRows,_
SearchDirection:=xlNext,_
MatchCase:=False,_
SearchFormat:=False)
If Not matchedCell Is Nothing Then
'~~> Color the cell
matchedCell.Interior.Color = RGB(255,255,0)
End If
Next aCell
End With
End Sub
,
这应该可以解决问题,我不喜欢在没有工作表的情况下离开范围,但是由于我相信您正在使用按钮,因此应该没有问题:
Option Explicit
Sub check_Click()
'We are going to use a dictionary,for it to work you need to:
'Go to Tools-References-Check the one called: Microsoft Scripting Runtime
Dim DatesToChange As Dictionary: Set DatesToChange = LoadDates
Dim area As Range: Set area = Range("B4:H9")
Dim item As Range
For Each item In area
If DatesToChange.Exists(item.Value) Then
item.Interior.Color = RGB(255,0)
End If
Next item
End Sub
Private Function LoadDates() As Dictionary
Set LoadDates = New Dictionary
Dim arr As Variant: arr = ThisWorkbook.Sheets(Range("E2")).Range("A:A")
Dim i As Long
For i = 2 To UBound(arr)
'This here will break the loop when finding an empty cell in column A
If arr(i,1) = vbNullString Then Exit For
'This will add all your dates in a dictionary (avoiding duplicates)
If Not LoadDates.Exists(arr(i,1)) Then LoadDates.Add arr(i,1),1
Next i
End Function
,
- 定义对象(例如范围,图纸)时,需要使用
setlocal /?
关键字
Set
-
Set area = Range("B4:H9") Set columnlist = Worksheets(sheet).Range("A2:A" & Rows.Count)
接受Worksheets()
或Integer
。因此,String
的类型应为sheet
String
您还将Dim sheet As String
设置为工作表的整个列,因此不必要地循环了数十万次。更改为
columnlist
以上内容应解决代码中的错误,并使其运行更快。但是,代码的效率仍有很大的改进空间。例如,您应该建立一个范围并在循环后设置一次颜色,而不是在循环内更改颜色。
还可以考虑在代码开头使用
重置颜色 With Worksheets(sheet)
Set columnlist = .Range(.Range("A2"),.Range("A" & Rows.Count).Offset(xlUp))
End With
我个人会使用注释中建议的@SiddharthRout的条件格式。
编辑评论后
这是我的演出
area.Interior.Pattern = xlNone
使用2500个日期列表,我的机器上花了0.0742秒。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。