Question

我想根据多种条件和细胞选择在一系列细胞中填充Color。这是代码

Sub color()



  Dim j As Integer
  Dim testfallname As String
  Dim rng As Range
  Dim rCell As Range
  Dim UnionRange As Range
  Dim wb As Workbook
  Dim ws As Worksheet

   Set wb = ThisWorkbook
   Set ws = wb.Sheets("1-BR_Vorschlag")

  ws.Activate
  For j = 7 To 1000
If ws.Cells(1, j) = "ARB11" Or ws.Cells(1, j) = "FVB1" Or ws.Cells(1, j) = "FVB4E" Then
testfallname = Cells(5, j)
Set rng = ws.Range("G5:AQ5").Find(testfallname)
End If

   Set UnionRange = Union(ws.Range(Cells(34, rng.Column), ws.Range(Cells(39, rng.Column), ws.Range(Cells(49, rng.Column), Cells(50, rng.Column), ws.Range(Cells(53, rng.Column), Cells(54, rng.Column), ws.Range(Cells(59, rng.Column), Cells(61, rng.Column), ws.Range(Cells(66, rng.Column), Cells(77, rng.Column), ws.Range(Cells(85, rng.Column), Cells(97, rng.Column)))))))))


With ws
  For Each rCell In UnionRange
        If rCell.Value = vbNullString Then
            rCell.Interior.color = 8421504
       End If
    Next rCell
End With
Next j

这是实际代码。现在我再次收到一个错误，说错误的争论数量或无效的财产分配。它调试Union Range行。我哪里错了？

Answer 1

您将目标表放在错误的位置。你像这样使用它（为了一个例子，这些值是随机的）：

Set UnionRange = Union(sheets("1-BR_Vorschlag").Range(cells(3, 10), cells(8, 9)), sheets("1-BR_Vorschlag").Range(cells(13, 22), cells(28, 49)))

基本上只需将目标移动到联合内部，它应该可以正常工作。我认为它可以这样工作，因此您可以同时在不同工作表的范围内使用union。

Answer 2

您可以使用SpecialCells(xlCellTypeBlanks)一次选择所有空白单元格。

Sub color()

    Dim r As Range
    With Worksheets("1-BR_Vorschlag")
        Set r = Union(.Cells(34, 7), .Cells(39, 7), .Cells(49, 7), .Cells(50, 7), .Range(.Cells(53, 7), .Cells(54, 7)), .Range(.Cells(59, 7), .Cells(61, 7)), .Range(.Cells(66, 7), .Cells(77, 7)), .Range(.Cells(85, 7), .Cells(97, 7)))
        Set r = r.SpecialCells(xlCellTypeBlanks)
        If Not r Is Nothing Then r.Interior.color = 8421504
    End With

End Sub

我发现使用Union方法有点乏味我更喜欢创建一个字符串并使用Range方法。

Sub Color2()

    Dim r As Range
    Set r = Worksheets("1-BR_Vorschlag").Range("$G$34,$G$39,$G$49:$G$50,$G$53:$G$54,$G$59:$G$61,$G$66:$G$77,$G$85:$G$97")
    Set r = r.SpecialCells(xlCellTypeBlanks)
    If Not r Is Nothing Then r.Interior.color = 8421504

End Sub

对象范围失败

2 个答案: