excel - 如果不同工作表上相同范围内的相应单元格已经着色,如何为范围内的单元格着色?
问题描述
在 VBA 中,我在一个范围内标记结果并根据单元格值将它们着色为绿色(例如 value <“28”)。
每张纸(共四张)对应一个不同的标记,并根据一个值标记为绿色。所有工作表都有相同的 X 和 Y 轴,感兴趣的范围是 (B2:BJ26)。
如果其他工作表中的所有四个相应单元格都涂成绿色,我想制作第五张工作表,将相应的单元格涂成绿色。
我可以一个单元一个单元地做这个。
简化示例
If Sheets(A) "B2" value < 30 AND Sheets(B) "B2" Value > 1.1 AND
Sheets(C) "B2" Value < 1500 AND Sheets(D) "B2" Value > 0.30 THEN
Sheets(E) "B2" interior.color = RGB(0,255,0)
对于 B2:BJ26 范围内的所有单元格,必须有一种更有效的方法。
前四张纸上颜色/标记值的工作代码示例。
Worksheets("1").Activate
Dim XXXXXXX As Range, cell As Range
Set XXXXXXX = Range("B2:BJ26")
For Each cell In XXXXXXX
If cell.Value < "28" And cell.Value > "1" Then
cell.Interior.Color = RGB(0, 255, 0)
End If
Next
建议的以下代码未在表 5 上着色任何内容
Sub ColorSheetFive()
Dim i As Integer
Dim m As Integer
Dim n As Integer
Dim allGreen As Boolean
For m = 2 To 26
For n = 2 To 62
allGreen = True
For i = 1 To 4
If Sheets(i).Cells(m, n).Interior.Color <> RGB(0, 255, 0) Then
allGreen = False
End If
Next i
If allGreen Then
Sheets(5).Cells(m, n).Interior.Color = RGB(0, 255, 0)
End If
Next n
Next m
MsgBox "Color checking complete!"
End Sub
解决方案
格式化相同的单元格
- 工作簿下载 (Dropbox)
- 近似(不精确)描述:此代码不检查第一个工作表的
Interior
颜色,而是检查每个单元格的Min
andMax
Criteria
并应用格式,同时计算列表中满足的条件的出现次数,然后对照第一个工作表的数量,如果找到,最后一个工作表中的相应单元格将被格式化。 - 您可以将更多工作表添加到工作表名称列表 (
cSheets
),但所有范围内的单元格,除了最后一个工作表,如果满足条件,将被格式化,而最后一个工作表范围内的单元格将被格式化,仅当所有先前工作表的范围内的所有单元格都符合标准。 - 根据需要调整常量部分中的其他值。
编码
Sub FormatSameCells()
' Worksheet Name List
Const cSheets As String = "Sheet1,Sheet2,Sheet3,Sheet4,Sheet5"
Const cRange As String = "B2:BJ26" ' Source Range Address
Const cMax As Long = 28 ' Max Criteria
Const cMin As Long = 1 ' Min Criteria
Const cColor As Long = 65280 ' Cell Color (Green)
Dim rng As Range ' Source Range, Target Range
Dim vntS As Variant ' Sheet Array
Dim vntR As Variant ' Range Array
Dim vntT As Variant ' Target Array
Dim NoS As Long ' Number of Sheets
Dim NoR As Long ' Number of Rows in Source Range
Dim NoC As Long ' Number of Columns in Source Range
Dim i As Long ' Range/Target Array Row Counter
Dim j As Long ' Sheet Array Element Counter,
' Range/Target Array Column Counter
Dim m As Long ' Sheet Array Element Counter
Dim str1 As String ' Debug String
' Copy Worksheet Name List to 1D 0-based Sheet Array.
vntS = Split(cSheets, ",")
' Calculate Number of Worksheets).
NoS = UBound(vntS)
With ThisWorkbook.Worksheets(Trim(vntS(UBound(vntS)))).Range(cRange)
' Calculate Number of Rows in Source Range/Range Array/Target Array.
NoR = .Rows.Count
' Calculate Number of Columns in Source Range/Range Array/Target Array.
NoC = .Columns.Count
End With
' Adjust Target Array to size of Source Range/Range Array.
ReDim vntT(1 To NoR, 1 To NoC) As Long
' Loop through all elements of Sheet Array, except the last one.
For m = 0 To NoS - 1
' Create a reference to current Source Range.
Set rng = ThisWorkbook.Worksheets(Trim(vntS(m))).Range(cRange)
' Clear Interior formatting in current Source Range.
rng.Cells.Interior.ColorIndex = xlNone
' Copy Source Range in current worksheet (m) to 2D 1-based 1-column
' array in Array Array.
vntR = rng
' Loop through rows of current array of Array Array.
For i = 1 To NoR
' Loop through columns of current array of Array Array.
For j = 1 To NoC
' Check value of current element of current array of
' Array Array for matching criteria.
If vntR(i, j) > cMin And vntR(i, j) < cMax Then
' Apply formatting to current cell in current Source Range.
rng.Cells(i, j).Interior.Color = cColor
' Increase the number in current cell of Target Array.
vntT(i, j) = vntT(i, j) + 1
End If
Next
Next
Next
' Display contents of Target Array.
str1 = String(40, "*") & vbCr & "Target Array [" & NoR & "," & NoC & "]" _
& vbCr & String(40, "*")
For i = 1 To NoR
str1 = str1 & vbCr
For j = 1 To NoC
str1 = str1 & vntT(i, j)
Next
Next
Debug.Print str1
' Create a reference to last (NoS) worksheet.
Set rng = ThisWorkbook.Worksheets(Trim(vntS(NoS))).Range(cRange)
' Clear formatting in Target Range.
With rng.Cells
.Interior.ColorIndex = xlNone
'.Font.Bold = False
End With
' Loop through rows of Target Array.
For i = 1 To NoR
' Loop through columns of Target Array
For j = 1 To NoC
' Check if value of current element is equal to NoS.
If vntT(i, j) = NoS Then
' Apply formatting to current cell in Target Range.
With rng.Cells(i, j)
.Interior.Color = cColor
'.Font.Bold = True
End With
End If
Next
Next
End Sub
在所有工作表中清除内部
Sub ClearInterior()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Cells.Interior.ColorIndex = xlNone
Next
End Sub
推荐阅读
- c# - .net core 注入 AWS 配置
- java - 为什么 Hibernate 不批量插入带有 @ElementCollection 注释的字段?
- r - 以 R 中的 %H:%M:%S 格式计算时间差
- android - 仅对所有 Room 记录异步迭代一次
- json - JsonConvert.DeserializeObject 未将 json 值设置为属性
- python-3.x - CVXPY 无法最大化功能
- postgresql - 在单个表上对 Postgres 进行递归查询
- swift - 在 captureOutput 上应用过滤器非常滞后,并且在特定时间后崩溃
- c# - Docusign API:如何使用应用程序令牌
- c++ - Qt C++ QStyledItemDelegate 子类 - 鼠标悬停在油漆上