VBA 格式条件 IF 最佳方法

Question

翻译成vba的最佳方法是什么，格式条件如下： 如果sheet1.cells1 =“ll”和sheet2.cells1 =“pp”那么... 如果sheet1.cells160 =“ok”并且sheet2.cells1 =“pp”那么...

我有 2 张。第一个，每个单元格上都有 3 个选项的引用：核心、非核心和 N/A。 基于此参考，第二张纸必须应用格式条件。 它不起作用，因为 vba 必须在每个单元格上写入。 任何帮助将不胜感激。

因此，在工作表 1 的第一个单元格中，我有“Core”，例如， 然后在我必须应用 formatCondition 的第二张纸上，例如我有“购买”，它应该变成红色。它可以工作，但由于数据量过大，Excel 停止工作。 ArrTempB 变为 100。 arrTempCD 达到 1300

代码我已经有了。

Option Explicit

Private Sub buttonReapply3_Click()


Dim wb As Workbook
Dim wsB As Worksheet
Dim wsC As Worksheet
Dim wsD As Worksheet
For Each wb In Application.Workbooks ' Loop through all open workbooks

    On Error Resume Next
    Set wsB = wb.Worksheets("B) CNC Analysis")
    Set wsC = wb.Worksheets("C) As-Is MoB&F")
    Set wsD = wb.Worksheets("D) MoB&F Analysis")
    On Error GoTo 0
    Dim feuille As String: feuille = "'B) CNC Analysis'!"
    Dim plage As Range: Set plage = Nothing
    If Not wsB Is Nothing Then
        Dim arrBase() As String: arrBase = getDataBase(wsB) 'données onglet B
        
        If Not wsC Is Nothing Then ' If the worksheet is found, proceed with cleaning
            Set plage = getRange(wsC)  'getRange C) As-Is MoB&F
            plage.FormatConditions.Delete
            Call setGeneralFormat(plage)    ' applique le format conditionnel general,C) As-Is MoB&F
            Dim arrTempC() As String: arrTempC = getDataOnglet(wsC, plage) ' données onglet C
            
            Call SetRedFormat(wsB, wsC, arrBase(), arrTempC(), plage, feuille) ' applique critères si Rouge sur l´onglet C
            
        End If
    
            Set plage = Nothing
    
        If Not wsD Is Nothing Then
             Set plage = getRange(wsD)   'getRange D) MoB&F Analysis
             plage.FormatConditions.Delete
            Call setGeneralFormat(plage)  'applique le format conditionnel general,D) MoB&F Analysis
            Dim arrTempD() As String: arrTempD = getDataOnglet(wsD, plage) ' données onglet D
            
             Call SetRedFormat(wsB, wsD, arrBase(), arrTempD(), plage, feuille) ' applique critères si Rouge sur l´onglet D
        End If
    End If
Next wb

MsgBox "Conditional formatting has been reapplied to the range.", vbInformation  ' Show a message that the formatting has been reapplied
End Sub
'function onglets données à verifier
Function getDataOnglet(ws As Worksheet, r As Range) As Variant

Dim arrTemp() As String
Dim firstrow As Integer: firstrow = r.Row
Dim lastRow As Integer: lastRow = r.Rows(r.Rows.count).Row
Dim firstColSol As Integer: firstColSol = r.Column
Dim lastColSol As Integer: lastColSol = r.Columns(r.Columns.count).Column

    With ws
        Dim rango As Range: Set rango = .Range("A1:ZZ1000").Find("Sub-Activity", LookIn:=xlValues)
        Dim rangoSol As Range: Set rangoSol = .Range("J1:ZZ1000").Find("Current Make", LookIn:=xlValues)

'2) on remplit arrTemp avec les données du tableau.
        ReDim arrTemp((lastRow + 1 - firstrow) * (lastColSol + 1 - firstColSol), 4)
        Dim contador As Long: contador = 0
        Dim j As Long, i As Long

            For j = firstColSol To lastColSol
                For i = firstrow To lastRow
                    If .Cells(rangoSol.Row - 1, j) <> "" Then
                  arrTemp(contador, 0) = .Cells(i, rango.Column) ' valeur de sub activity
                  arrTemp(contador, 1) = .Cells(rangoSol.Row - 1, j) ' valeur de solution ( -1) car ce sera la ligne au dessus
                  arrTemp(contador, 2) = i 'linea
                  arrTemp(contador, 3) = j 'columna
                  arrTemp(contador, 4) = .Cells(i, j).Value   ' valeur de la cellule
                  contador = contador + 1
                  End If
                Next 'i
            Next 'j
        End With
    getDataOnglet = arrTemp
End Function

'3) On applique les critères de l'onglet
Function SetRedFormat(ws As Worksheet, wsCD As Worksheet, arrTempB As Variant, arrTempCD As Variant, plage As Range, f As String)
Dim i As Long, j As Long
Dim rD As Variant, rB As Variant

For i = LBound(arrTempB) To UBound(arrTempB)
    For j = LBound(arrTempCD) To UBound(arrTempCD)
        If arrTempCD(j, 0) <> "" Then
'       If arrTempCD(j, 0) = arrTempB(i, 0) And arrTempCD(j, 1) = arrTempB(i, 1) Then

    'ici les condition de Var:
        rD = ws.Cells(CInt(arrTempCD(j, 2)), CInt(arrTempCD(j, 3))).Address(RowAbsolute:=False, ColumnAbsolute:=False)
        rB = wsCD.Cells(CInt(arrTempB(i, 3)), CInt(arrTempB(i, 4))).Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Dim frm As String: frm = "=OR(AND(" & f & rB & "=""Core"";" & rD & "=""Buy"")," & _
      "AND(" & f & rB & "=""Core"";" & rD & "=""N/A"")," & _
      "AND(" & f & rB & "=""N/A"";" & rD & "<>""N/A"")," & _
      "AND(" & f & rB & "=""Non-Core"";" & rD & "=""N/A""))"
            Range(rD).Select
            With Selection
            .FormatConditions.Add Type:=xlExpression, Formula1:=frm
        '    .FormatConditions.Add Type:=xlExpression, Formula1:="=AND(" & f & rB & "=""Core"";" & rD & "=""Buy"")"
            .FormatConditions(.FormatConditions.count).SetFirstPriority
                With .FormatConditions(1).Interior
                    .PatternColorIndex = xlAutomatic
                    .color = 255
                    .TintAndShade = 0
                End With
                .FormatConditions(1).StopIfTrue = False
        End With
        End If
    Next 'j
Next 'i
End Function

' Apply the conditional formatting w/o depedency
Sub setGeneralFormat(plage As Range)
'Range(plage).Select
    With plage
          'N/A
              .FormatConditions.Add Type:=xlTextString, String:="N/A", TextOperator:=xlBeginsWith
              .FormatConditions(.FormatConditions.count).SetFirstPriority
              With .FormatConditions(1).Interior
                  .PatternColorIndex = xlAutomatic
                  .color = RGB(166, 166, 166)
                  .TintAndShade = 0
              End With

          'Make
              .FormatConditions.Add Type:=xlTextString, String:="Make", TextOperator:=xlBeginsWith
              .FormatConditions(.FormatConditions.count).SetFirstPriority
              With .FormatConditions(1).Interior
                  .Pattern = xlSolid
                  .PatternColorIndex = xlAutomatic
                  .color = RGB(36, 42, 117)
                  .TintAndShade = 0
                  .PatternTintAndShade = 0
              End With
              With .FormatConditions(1).Font
                   .color = RGB(255, 255, 255)
              End With

          'Make other CC
              .FormatConditions.Add Type:=xlTextString, String:="Make other CC", _
              TextOperator:=xlBeginsWith
              .FormatConditions(.FormatConditions.count).SetFirstPriority
              With .FormatConditions(1).Interior
                  .Pattern = xlSolid
                  .PatternColorIndex = xlAutomatic
                  .color = RGB(48, 84, 150)
                  .TintAndShade = 0
                  .PatternTintAndShade = 0
              End With
              With .FormatConditions(1).Font
                   .Bold = True
                   .color = RGB(255, 255, 255)
              End With


          'Make ECC
              .FormatConditions.Add Type:=xlTextString, String:="Make ECC", _
              TextOperator:=xlBeginsWith
              .FormatConditions(.FormatConditions.count).SetFirstPriority
              With .FormatConditions(1).Interior
                  .Pattern = xlSolid
                  .PatternColorIndex = xlAutomatic
                  .color = RGB(112, 112, 184)
                  .TintAndShade = 0
                  .PatternTintAndShade = 0
              End With


          'Buy
              .FormatConditions.Add Type:=xlTextString, String:="Buy", TextOperator:=xlBeginsWith
              .FormatConditions(.FormatConditions.count).SetFirstPriority
              With .FormatConditions(1).Interior
                  .Pattern = xlSolid
                  .PatternColorIndex = xlAutomatic
                  .color = RGB(93, 191, 212)
                  .TintAndShade = 0
              End With
              
        ' make ecc or buy
        .FormatConditions.Add Type:=xlTextString, String:="Make ECC or Buy", TextOperator:=xlContains
    .FormatConditions(.FormatConditions.count).SetFirstPriority
    With .FormatConditions(1).Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 0
        .Gradient.ColorStops.Clear
    End With
    With .FormatConditions(1).Interior.Gradient.ColorStops.Add(0)
        .color = 12087408
        .TintAndShade = 0
    End With
    With .FormatConditions(1).Interior.Gradient.ColorStops.Add(1)
        .color = 13942621
        .TintAndShade = 0
    End With
    .FormatConditions(1).StopIfTrue = False
    End With
End Sub

Function getRange(ws As Worksheet) As Range
    With ws
          .Cells.EntireRow.Hidden = False
          .Cells.EntireColumn.Hidden = False
        Dim rango As Range: Set rango = .Range("A1:ZZ1000").Find("Sub-Activity", LookIn:=xlValues)
        If Not rango Is Nothing Then
            Dim subActNumCol As Integer: subActNumCol = rango.Column ' numero de colonne de Sub Activity
            Dim firstrow As Integer: firstrow = rango.Row + 1 ' premiere ligne
            Dim lastRow As Integer: lastRow = .Cells(.Rows.count, subActNumCol).End(xlUp).Row ' dernier ligne
            lastRow = lastRow - 1 ' ainsi il n´y a pas la ligne total
        End If
        
        Dim rangoSol As Range: Set rangoSol = .Range("J1:ZZ1000").Find(Trim("Current Make"), LookIn:=xlValues)
        If Not rangoSol Is Nothing Then
            Dim firstColSol As Integer: firstColSol = rangoSol.Column + 1 ' premiere colonne de solution
            Dim lastColSol As Integer: lastColSol = .Cells(rangoSol.Row - 1, Columns.count).End(xlToLeft).Column ' derniere colonne de solution-1 pour la colonne total
        End If
        lastColSol = lastColSol - 1 'ainsi il n´y a pas la colonne total
        
        Dim a
        a = Split(Cells(1, firstColSol).Address(True, False), "$")
        Dim b
        b = Split(Cells(1, lastColSol).Address(True, False), "$")
        Dim r As Range: Set r = Range(a(0) & firstrow & ":" & b(0) & lastRow)
      End With
    Set getRange = r


End Function
Function getDataBase(ws As Worksheet) As Variant
' Format conditionel en fonction des données de l' onglet B) CNC Analysis.

    Dim arrTempB() As String '1) on remplit arrTempB avec les données du tableau.
    Dim j As Long, i As Long
    Dim contador As Long: contador = 0

    With ws
        Dim rangoB As Range: Set rangoB = .Range("A1:ZZ1000").Find("Sub-Activity", LookIn:=xlValues)
        Dim firstrowB As Integer: firstrowB = rangoB.Row + 2 ' premiere ligne
        Dim subActNumCol As Integer: subActNumCol = rangoB.Column ' numero de colonne
        Dim lastRowB As Integer: lastRowB = .Cells(.Rows.count, subActNumCol).End(xlUp).Row ' derniere ligne
        If .Cells(lastRowB, subActNumCol).Value = "Total" Then lastRowB = lastRowB - 1
        Dim sol As Range: Set sol = .Range("A1:ZZ1000").Find("Insert a new solution after this column", LookIn:=xlValues)
        If Not sol Is Nothing Then
            Dim firstColSolB As Integer: firstColSolB = sol.Column + 1 ' premiere colonne
        End If
        Dim lastColSolB As Integer: lastColSolB = .Cells(sol.Row, Columns.count).End(xlToLeft).Column ' derniere colonne
        Dim a As Integer, b As Integer
        a = firstrowB - lastRowB
        b = firstColSolB - lastColSolB
                For j = firstColSolB To lastColSolB
            For i = firstrowB To lastRowB
            If .Cells(i, j).Value <> "" Then contador = contador + 1
            Next
            Next
        ReDim arrTempB(contador, 4)
        contador = 0
        For j = firstColSolB To lastColSolB
            For i = firstrowB To lastRowB
                If .Cells(i, j).Value <> "" And .Cells(sol.Row, j) <> "" Then
                    arrTempB(contador, 0) = .Cells(i, subActNumCol) ' valeur de sub-activity
                    arrTempB(contador, 1) = .Cells(sol.Row, j) ' valeur de solution
                    arrTempB(contador, 2) = .Cells(i, j).Value ' valeur de la cellule
                    arrTempB(contador, 3) = i
                    arrTempB(contador, 4) = j
                    contador = contador + 1
                End If
            Next 'i
        Next 'j
    End With
    getDataBase = arrTempB
End Function

Answer 1

仅供参考，您可以将这些公式批量合并为一个：

frm = "=OR(AND(" & f & rB & "=""Core"";" & rD & "=""Buy"")," & _
      "AND(" & f & rB & "=""Core"";" & rD & "=""N/A"")," & _
      "AND(" & f & rB & "=""N/A"";" & rD & "<>""N/A"")," & _
      "AND(" & f & rB & "=""Non-Core"";" & rD & "=""N/A""))"

...但这似乎还是有点不对劲