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

Question

我想创建一个条件格式。附上图片为例。因此，如果合并单元格中有一个值，我想对单元格和下面的另外两个单元格应用一些格式。有 4 种类型的值 Onsite、Home、Holiday、Not Available。如何使用条件格式或 VBA 脚本来实现？

谢谢

Answer 1

您可以使用常规的条件格式，但这有点麻烦。
也许有一条捷径可以让它变得更简单，但一种方法是基本上制定 12 个条件。每种颜色一个，每种类型的单元格一个（合并、左侧合并、右侧合并）。然后将公式应用于所需的整个范围。

以我为例，我的网格是H1:K14
所以在 H1 中，我有 4 条规则说明 =H1="Home"、=H1="Onsite" 等等所有颜色。然后申请H1:K14
在H2中是同样的公式：=H1="Home"、=H1="Onsite"等，然后应用到H2:K14
然后再次使用相同的公式 I2 =H1="Home"、=H1="Onsite" 等等，应用于 I2:K14

Answer 2

好的，找到答案软件了。我为此使用了 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

这次删除为我创建了自定义样式。运行如果我对代码进行更改，则按需提供。删除了极端样式，使代码保持排序。

如果值为“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 而不是合并单元格。看起来一样，但不是那个越野车。

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

Excel conditional formating. Maybe with VBA script?

excel

vba

conditional-formatting