excel - 使用循环中的单个单元格作为触发器来复制多个范围 VBA

Question

该宏正在使用硬编码输入，但我需要循环来进行调试和 future 的增长。我不知道设置它的最佳方法。
Range("b3:b8:) 是我想循环的单元格。
如果 cell.value = 1 那么
Set var1 = range("a3:aq3") (* 这个范围总是与循环中的单元格具有相同的行号*)
Set var2 = range("a9:aq9") (*此范围始终比循环中的单元格行大 6。)
万一
下一个单元格
谢谢

Answer 1

循环遍历范围的行

Option Explicit

Sub LoopThroughRows()
    
    Const srgAddress As String = "A3:AQ8"
    Const scCol As Long = 2
    Const sCriteria As String = "1"
    
    Dim sws As Worksheet: Set sws = ActiveSheet ' improve, e.g.:
    'Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    'Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
    
    Dim srg As Range: Set srg = sws.Range(srgAddress) ' last use of 'sws'
    Dim srCount As Long: srCount = srg.Rows.Count
    
    Dim srg1 As Range
    Dim srg2 As Range
    Dim sCell As Range
    Dim sr As Long
    
    For Each sCell In srg.Columns(scCol).Cells ' don't forget '.Cells'!
        sr = sr + 1 ' monitoring each range row (not worksheet row)
        If CStr(sCell.Value) = sCriteria Then ' also avoiding error values
            Set srg1 = srg.Rows(sr)
            Set srg2 = srg1.Offset(srCount)
            ' Continue... e.g.:
            Debug.Print sr, sCell.Address(0, 0), _
                srg1.Address(0, 0), srg2.Address(0, 0)
        Else ' not equal to sCriteria (usually do nothing)
            ' e.g.:
            Debug.Print sr, sCell.Address(0, 0), "Nope."
        End If
    Next sCell
    
End Sub