如何以行号作为变量遍历特定范围？

Question

我有一堆公式适用于我的数据中的特定（非连续）范围。有没有办法用数组和/或循环在更少的行中做到这一点？

.Range("R" & RowA).FormulaR1C1 = "=RC[-1]"
.Range("W" & RowA).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
.Range("Y" & RowA).FormulaR1C1 = "=RC[-12]*RC[-2]"

.Range("R" & RowB).FormulaR1C1 = "=RC[-1]"
.Range("W" & RowB).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
.Range("Y" & RowB).FormulaR1C1 = "=RC[-12]*RC[-2]"

.Range("R" & RowC).FormulaR1C1 = "=RC[-1]"
.Range("W" & RowC).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
.Range("Y" & RowC).FormulaR1C1 = "=RC[-12]*RC[-2]"

Answer 1

是的，尽管我怀疑与您的想法不太一样。使用数组而不是单独的变量 RowA、RowB 和 RowC，这样你就可以替换

Dim RowA as Long, RowB as Long, RowC as Long
RowA = 1
RowB = 3
RowC = 7 'example figures

与-

Dim Row(1 to 3) as Long
Row(1) = 1
Row(2) = 3
Row(3) = 7

那么你上面的代码可以缩短为如下循环：

For a = Lbound(Row) to Ubound(Row)
    .Range("R" & Row(a)).FormulaR1C1 = "=RC[-1]"
    .Range("W" & Row(a)).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
    .Range("Y" & Row(a)).FormulaR1C1 = "=RC[-12]*RC[-2]"
Next

Answer 2

我会将行存储在一个数组中，然后使用Union 将所有行收集到一个变量中，并使用Intersect 收集每一列。

这样您可以一次访问特定列的所有已定义行。

Option Explicit

Public Sub example()
    Dim RowArr() As Variant
    RowArr = Array(1, 3, 17) 'define your rows here
    
    Dim AllRows As Range
        
    With ActiveSheet
        Dim Row As Variant
        For Each Row In RowArr
            If AllRows Is Nothing Then
                Set AllRows = .Rows(Row)
            Else
                Set AllRows = Union(AllRows, .Rows(Row))
            End If
        Next Row
        
        'write in all rows of a specific column
        Intersect(.Columns("R"), AllRows).FormulaR1C1 = "=RC[-1]"
        Intersect(.Columns("W"), AllRows).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
        Intersect(.Columns("Y"), AllRows).FormulaR1C1 = "=RC[-12]*RC[-2]"
    End With
End Sub

除了循环，你也可以写：

Set AllRows = .Range("1:1,3:3,17:17")

喜欢

Option Explicit

Public Sub example()
    With ActiveSheet
        Dim AllRows As Range
        Set AllRows = .Range("1:1,3:3,17:17")
        
        'write in all rows of a specific column
        Intersect(.Columns("R"), AllRows).FormulaR1C1 = "=RC[-1]"
        Intersect(.Columns("W"), AllRows).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
        Intersect(.Columns("Y"), AllRows).FormulaR1C1 = "=RC[-12]*RC[-2]"
    End With
End Sub

但这仅适用于少量的行。如果你有更多你需要使用Union

Answer 3

可能是这样的：

Sub Test()
Dim letters, rows, i, letter, row

letters = Array("R", "W", "Y")
rows = Array(1, 5, 17)          'RowA, RowB, and so on...
i = 0
j = 0
For Each row In rows
    For Each letter In letters
        Debug.Print letters(i) & rows(j)
    '    .Range(letters(i) & rows(i)).FormulaR1C1 = "=RC[-1]"
    '    .Range(letters(i) & rows(i)).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
    '    .Range(letters(i) & rows(i)).FormulaR1C1 = "=RC[-12]*RC[-2]"
         
        i = i + 1
    Next letter
    j = j + 1
    i = 0
Next row

End Sub

Answer 4

使用“助手”程序

Option Explicit

Sub UsingRefRows()
    
    Const RowA As Long = 1
    Const RowB As Long = 3
    Const RowC As Long = 5
    
    Dim ws As Worksheet: Set ws = Sheet1
    
    Dim rrg As Range: Set rrg = RefRows(ws, RowA, RowB, RowC)
    
    Intersect(rrg, ws.Columns("R")).FormulaR1C1 = "=RC[-1]"
    Intersect(rrg, ws.Columns("W")).FormulaR1C1 = "=RC[-5]*RC[-7]+RC[-2]"
    Intersect(rrg, ws.Columns("Y")).FormulaR1C1 = "=RC[-12]*RC[-2]"

End Sub

Sub UsingRefRowsAndWriteRowsR1C1()
    
    Const RowA As Long = 1
    Const RowB As Long = 3
    Const RowC As Long = 5
    
    Const ColumnsList As String = "R,W,Y"
    Const FormulasList As String _
        = "=RC[-1]" & "," _
        & "=RC[-5]*RC[-7]+RC[-2]" & "," _
        & "=RC[-12]*RC[-2]"
    
    Dim ws As Worksheet: Set ws = Sheet1
    
    Dim rrg As Range: Set rrg = RefRows(ws, RowA, RowB, RowC)
    
    WriteRowsR1C1 rrg, ColumnsList, FormulasList
    
End Sub


Function RefRows( _
    ByVal ws As Worksheet, _
    ParamArray DataRows() As Variant) _
As Range
    Dim rg As Range
    Dim n As Long
    For n = 0 To UBound(DataRows)
        If rg Is Nothing Then
            Set rg = ws.Rows(DataRows(n))
        Else
            Set rg = Union(rg, ws.Rows(DataRows(n)))
        End If
    Next n
    If Not rg Is Nothing Then
        Set RefRows = rg
    End If
End Function

Sub WriteRowsR1C1( _
        ByVal RowsRange As Range, _
        ByVal ColumnsList As String, _
        ByVal FormulasList As String)
    
    Dim Cols() As String: Cols = Split(ColumnsList, ",")
    Dim Formulas() As String: Formulas = Split(FormulasList, ",")
    Dim ws As Worksheet: Set ws = RowsRange.Worksheet
    
    Dim n As Long
    For n = 0 To UBound(Cols)
        Intersect(RowsRange, ws.Columns(Cols(n))).FormulaR1C1 = Formulas(n)
    Next n
    
End Sub