Excel 条件格式。也许用VBA脚本？

好的，所以找到了answare。我为此使用了 VBA 脚本。准确地说，我使用 3 个脚本。一种用于创建自定义样式。

Sub f_isStyleExists(stylName As String)

    Dim styl As Style

    On Error Resume Next
    Set styl = ActiveWorkbook.Styles(stylName)

    If Err.Number = 0 Then styl.Delete
End Sub

Sub Delete()
f_isStyleExists ("Smart Office")
End Sub

Sub Create_Styles()
Delete
With ActiveWorkbook.Styles.Add("Smart Office")
 .IncludeNumber = False
 .IncludeFont = True
 .IncludeAlignment = True
 .IncludeBorder = False
 .IncludePatterns = True
 .IncludeProtection = False
 .Font.Name = "Arial"
 .Font.Size = 12
 .Font.Color = vbBlack
 .Interior.Color = RGB(198, 224, 180)
 .HorizontalAlignment = xlHAlignCenter
 .VerticalAlignment = xlVAlignCenter
End Wit
End Sub

此删除比为我创建自定义样式。如果我对代码进行更改，则按需运行。删除了extre 样式，使代码保持排序。

如果值为“Smart Office”或“ONSITE”等，这将检查更改的单元格（也删除了额外的行）

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Integer
Dim y As Integer
x = ActiveCell.Row
y = ActiveCell.Column

        If Worksheets("Sheet1").Cells(x, y).Value = "Smart Office" Then
           Worksheets("Sheet1").Cells(x, y).Style = "Smart Office"
           Worksheets("Sheet1").Cells(x + 1, y).Style = "Smart Office"
           Worksheets("Sheet1").Cells(x, y + 1).Style = "Smart Office"
           Worksheets("Sheet1").Cells(x + 1, y + 1).Style = "Smart Office"
           Worksheets("Sheet1").Cells(x, y).NumberFormat = "@"
           Worksheets("Sheet1").Cells(x + 1, y).NumberFormat = "hh:mm"
           Worksheets("Sheet1").Range(Cells(x, y), Cells(x, y + 1)).HorizontalAlignment = xlCenterAcrossSelection
        ElseIf Worksheets("Sheet1").Cells(x, y).Value = "ONSITE" Then
           Worksheets("Sheet1").Cells(x, y).Style = "ONSITE"
           Worksheets("Sheet1").Cells(x + 1, y).Style = "ONSITE"
           Worksheets("Sheet1").Cells(x + 1, y + 1).Style = "ONSITE"
           Worksheets("Sheet1").Cells(x, y + 1).Style = "ONSITE"
           Worksheets("Sheet1").Cells(x, y).NumberFormat = "@"
           Worksheets("Sheet1").Cells(x + 1, y).NumberFormat = "hh:mm"
           Worksheets("Sheet1").Range(Cells(x, y), Cells(x, y + 1)).HorizontalAlignment = xlCenterAcrossSelection
        
        End If
            
End Sub

我还添加了一个 double for 在保存之前重新检查所有单元格，这样在特殊情况下它就不会失败。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim x As Integer
Dim y As Integer

'X is row Y is column

For x = 7 To 100 Step 2
    For y = 2 To 100 Step 2
        If Worksheets("Sheet1").Cells(x, y).Value = "Smart Office" Then
           Worksheets("Sheet1").Cells(x, y).Style = "Smart Office"
           Worksheets("Sheet1").Cells(x + 1, y).Style = "Smart Office"
           Worksheets("Sheet1").Cells(x, y + 1).Style = "Smart Office"
           Worksheets("Sheet1").Cells(x + 1, y + 1).Style = "Smart Office"
           Worksheets("Sheet1").Cells(x, y).NumberFormat = "@"
           Worksheets("Sheet1").Cells(x + 1, y).NumberFormat = "hh:mm"
           Worksheets("Sheet1").Range(Cells(x, y), Cells(x, y + 1)).HorizontalAlignment = xlCenterAcrossSelection
        ElseIf Worksheets("Sheet1").Cells(x, y).Value = "ONSITE" Then
           Worksheets("Sheet1").Cells(x, y).Style = "ONSITE"
           Worksheets("Sheet1").Cells(x + 1, y).Style = "ONSITE"
           Worksheets("Sheet1").Cells(x + 1, y + 1).Style = "ONSITE"
           Worksheets("Sheet1").Cells(x, y + 1).Style = "ONSITE"
           Worksheets("Sheet1").Cells(x, y).NumberFormat = "@"
           Worksheets("Sheet1").Cells(x + 1, y).NumberFormat = "hh:mm"
           Worksheets("Sheet1").Range(Cells(x, y), Cells(x, y + 1)).HorizontalAlignment = xlCenterAcrossSelection
        End If
    Next y
Next x
End Sub

它并不完美，但可以工作。我可以用一些函数认真地缩短代码。共享工作簿没问题。使用 centeracrossselection 代替合并单元格。看起来一样，但不是那辆马车。