使用VBA联合函数有条件地将单元格添加到范围

我正在尝试使用联合方法将特定的单元格添加到各自的范围，具体取决于它们的内部颜色。 我正在使用的代码如下所示：

For Each cell In EntirePossibleRange If cell.Interior.Color = RGB(132, 151, 176) Then Set AccessabilityRange = Union(AccessabilityRange, Range("B" & cell.Row) Else If cell.Interior.Color = RGB(244, 176, 132) Then Set ConsistencyRange = Union(ConsistencyRange, Range("B" & cell.Row) Else If cell.Interior.Color = RGB(255, 217, 102) Then Set EfficacyRange = Union(EfficacyRange, Range("B" & cell.Row) Else cell.Interior.Color = RGB(191, 191, 191) Then Set WiderImpactsRange = Union(WiderImpactsRange, Range("B" & cell.Row) End If Next cell End Sub 

但是，代码将不会运行，并引发语法错误。 我无法弄清楚是什么语法错误。

Answer 1

您可以添加一个单独的函数来避免每次重复相同的代码检查：

 Function JoinRanges(r1 As Range, r2 As Range) As Range If r1 Is Nothing Then Set JoinRanges = r2 Else If r2 Is Nothing Then Set JoinRanges = r1 Else Set JoinRanges = Union(r1, r2) End If End If End Function 

那么你的代码就变成了（我也会使用Select Case ;））：

 For Each cell In EntirePossibleRange Select Case cell.Interior.Color Case RGB(132, 151, 176) Set AccessabilityRange = JoinRanges(AccessabilityRange, Range("B" & cell.Row)) Case RGB(244, 176, 132) Set ConsistencyRange = JoinRanges(ConsistencyRange, Range("B" & cell.Row)) Case RGB(255, 217, 102) Set EfficacyRange = JoinRanges(EfficacyRange, Range("B" & cell.Row)) Case RGB(191, 191, 191) Set WiderImpactsRange = JoinRanges(WiderImpactsRange, Range("B" & cell.Row)) End Select Next cell 

Answer 2

会更清楚地使用Select Case和处理尚不存在的范围，即。

 For Each cell In EntirePossibleRange Select Case cell.Interior.Color Case RGB(132, 151, 176) If Not AccessabilityRange Is Nothing Then Set Accessabilange = Union(AccessabilityRange, Range("B" & cell.Row)) Else Set Accessabilange = Range("B" & cell.Row) End If Case RGB(244, 176, 132) If Not ConsistencyRange Is Nothing Then Set ConsistencyRange = Union(ConsistencyRange, Range("B" & cell.Row)) Else Set SetConsistencyRange = Range("B" & cell.Row) End If 'étc Case Else 'other option here End Select Next cell