Question

VBA的新功能在这里。我正在尝试合并代码，避免复制/粘贴一百万次。基本上，如果特定的单元格（但不相邻：例如，不在列或范围内）为空白，则这些单元格将用颜色边框进行颜色填充。将数据输入任何单元格后，该特定单元格将删除所有格式。如果该单元格被清空，则格式返回。这些单元彼此独立。只是格式化要更改的单元格。

这是我的冗余代码中的一个示例，该示例可以正常工作，但是可以有一种方法可以将其编写一次，而只是批量识别目标单元格，可以这么说吗？将“ H154”和“ H151”等放在一行上？

谢谢。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "H154" Then
    If Target.Value <> "" Then
        Target.Interior.ColorIndex = xlNone
        Target.Borders.LineStyle = xlLineStyleNone
        Else: Target.Interior.Color = RGB(226, 239, 218)
         Target.Borders.LineStyle = xlContinuous
         Target.Borders.ColorIndex = 43
    End If
 End If

  If Target.Address(False, False) = "H151" Then
    If Target.Value <> "" Then
        Target.Interior.ColorIndex = xlNone
        Target.Borders.LineStyle = xlLineStyleNone
        Else: Target.Interior.Color = RGB(226, 239, 218)
         Target.Borders.LineStyle = xlContinuous
         Target.Borders.ColorIndex = 43
    End If
 End If

If Target.Address(False, False) = "E3" Then
If Target.Value <> "" Then
Target.Interior.ColorIndex = xlNone
Target.Borders.LineStyle = xlLineStyleNone
Target.Borders.ColorIndex = xlNone
Else: Target.Interior.Color = RGB(226, 239, 218)
Target.Borders.LineStyle = xlContinuous
Target.Borders.ColorIndex = 43
     End If
  End If

     If Target.Address(False, False) = "E9" Then
If Target.Value <> "" Then
Target.Interior.ColorIndex = xlNone
Target.Borders.LineStyle = xlLineStyleNone
Target.Borders.ColorIndex = xlNone
Else: Target.Interior.Color = RGB(226, 239, 218)
Target.Borders.LineStyle = xlContinuous
Target.Borders.ColorIndex = 43
     End If
  End If

Answer 1

已测试：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, c As Range, blnk As Boolean

    'any changed cells in the range of interest?
    'adjust range to suit...
    Set rng = Application.Intersect(Target, _
              Me.Range("H154,H151,E3,E9"))

    If Not rng Is Nothing Then
        'check each changed cell
        For Each c In rng
            blnk = (Len(c.Value) = 0) 'is it empty ?
            c.Interior.ColorIndex = IIf(blnk, 43, xlNone)
            c.Borders.LineStyle = IIf(blnk, xlContinuous, xlLineStyleNone)
            If blnk Then c.Borders.ColorIndex = 43
        Next c
    End If

End Sub

如何使用VBA根据指定单元格中ANY的值格式化单元格？

1 个答案: