Использовать логический не оператор два раза это означает! true = false и !! true = true
Ваш код ColorSheetFive
работает без проблем?!
Option Explicit
Sub ColorSheet5()
Dim RelevantRange As Range
Dim RangeStr As String
'vbGreen = 65280
'rgb(0,255,0) = 65280
Set RelevantRange = Range("B2:BJ26")
For Each actCell In RelevantRange
RangeStr = actCell.Address
'Debug.Print Sheets("Sheet" & iCt).Range(RangeStr).Address
If Check4Sheets(RangeStr, vbGreen) Then
actCell.Interior.Color = vbGreen
End If
Next actCell
End Sub
Function Check4Sheets(CheckRange As String, RGB_Color As Long) As Boolean
Check4Sheets = True
If Check_Intertior_Color(1, CheckRange, RGB_Color) = False Then _
Check4Sheets = False
If Check_Intertior_Color(2, CheckRange, RGB_Color) = False Then _
Check4Sheets = False
If Check_Intertior_Color(3, CheckRange, RGB_Color) = False Then _
Check4Sheets = False
If Check_Intertior_Color(4, CheckRange, RGB_Color) = False Then _
Check4Sheets = False
End Function
Function Check_Intertior_Color(SheetNr As Integer, CheckRange As String, RGB_Color As Long) As Boolean
Check_Intertior_Color = False
With Worksheets(SheetNr).Range(CheckRange)
If .Interior.Color = RGB_Color Then
Check_Intertior_Color = True
End If
End With
End Function
Min
и Max
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