如何迭代每n行并再次循环？

Question

我需要采样数据。

例如

1. 如果是 552 行，从第 2 行开始采样
2. 对于计算的采样频率，例如 8。
   从第 2 行开始，每第 8 行标记为“是”。
   如果确实覆盖了整个数据，则循环再次选择第 8 行，而忽略已选择的行。

Sub Sampling()

    Dim rngDataRange As Range
    Dim rngCombRange As Range
    Dim intRowNum, i As Integer
    Dim DSheet As Worksheet
    Set DSheet = Worksheets("Yardi Report")
    intRowNum = 1
    Set rngCombRange = Range(intRowNum & ":" & intRowNum + 5)
    For i = 1 To 552
        If intRowNum + 5 > 552 Then
            intRowNum = 5 - (552 - intRowNum) + 1
        Else
            intRowNum = intRowNum + 5
        End If
            
        Set rngDataRange = Range(intRowNum & ":" & intRowNum + 5)
        Set rngCombRange = Union(rngCombRange, rngDataRange)
        rngCombRange.Select
        Range(DSheet.Cells(rngCombRange.Row, "Q")).Interior.Color = 49407
    Next
End Sub

Answer 1

Option Explicit

Sub Sampling()

Dim maxRows As Long
Dim i As Long

Dim sampleSize As Long
Dim numSelected As Long

Dim DSheet As Worksheet

Set DSheet = Worksheets("Yardi Report")

StartRow = 2    ' data starts in row 2
newStartRow = StartRow

maxRows = 552   ' data ends in row 552

numSelected = 0

sampleStep = 8      ' Adjust as needed
sampleSize = 80     ' Adjust as needed

Do While numSelected < sampleSize
    
    For i = newStartRow To maxRows Step sampleStep
    
        Cells(i, 2) = "Yes"
        numSelected = numSelected + 1
        Debug.Print "Sample: " & numSelected
        
        If numSelected = sampleSize Then
            Exit Do
        End If
        
    Next
    
    newStartRow = newStartRow + 1
    Debug.Print "newStartRow: " & newStartRow
    Debug.Print "StartRow...: " & StartRow
    
    If numSelected < sampleSize Then
        Debug.Print "sampleStep + StartRow: " & sampleStep + StartRow
        
        If newStartRow = sampleStep + StartRow Then
            Exit Do
        End If
    End If
    
Loop

Debug.Print "Done " & Now

End Sub