如何用For循环简化多Range判断的VBA单元格选择代码？

需要处理15个Range，当前VBA代码存在冗余情况，原代码片段如下：

Sub Select_Cells()
Dim rg1 As Range, rg2 As Range, rg3 As Range
If [B7] > "" Then Set rg1 = [A1] Else Set rg1 = Nothing
If [B8] > "" Then Set rg2 = [B2] Else Set rg2 = Nothing
If [B9] > "" Then Set rg3 = [C3] Else Set rg3 = Nothing
Union(rg1, rg2, rg3).Select
End Sub

我尝试用For循环简化，但写法有误，错误代码如下：

rg1 = "[A1]": rg2 = "[B2]": rg3 = "[C3]"
r = 7
For x = 1 To 15
If Range("B" & r) > "" Then Set rg(x) = rg(x) Else Set rg(x) = Nothing
r=r+1
Next x
Union(rg1, rg2, rg3).Select

正确的简化实现 #

可以通过数组存储目标地址、循环构建合并范围的方式来优化，代码如下：

Sub Select_Cells_Improved()
    Dim combinedRange As Range
    ' 存储15个对应目标单元格的地址，按顺序对应B7到B21的判断
    Dim targetRanges As Variant
    targetRanges = Array("A1", "B2", "C3", "D4", "E5", "F6", "G7", "H8", "I9", "J10", "K11", "L12", "M13", "N14", "O15")
    
    Dim x As Integer
    Dim checkRow As Integer
    checkRow = 7 ' 起始判断行是B7
    
    For x = LBound(targetRanges) To UBound(targetRanges)
        ' 判断对应B列单元格是否非空
        If Range("B" & checkRow).Value <> "" Then
            If combinedRange Is Nothing Then
                ' 首次赋值
                Set combinedRange = Range(targetRanges(x))
            Else
                ' 合并已有范围
                Set combinedRange = Union(combinedRange, Range(targetRanges(x)))
            End If
        End If
        checkRow = checkRow + 1
    Next x
    
    ' 确保有有效范围时再执行选择，避免报错
    If Not combinedRange Is Nothing Then
        combinedRange.Select
    End If
End Sub

关键优化点：

• 用数组targetRanges统一管理15个目标单元格地址，便于维护和扩展
• 用combinedRange逐步合并符合条件的Range，无需单独声明15个Range变量
• 增加空对象判断，避免因无符合条件单元格导致的运行时错误
• 循环逻辑清晰，代码冗余度大幅降低

内容的提问来源于stack exchange，提问作者RJM