Question

我需要有关如何在下面重复此循环直到电子表格结束的帮助。我在下面建立了2个循环以处理前50行，并且工作正常。但是，我还需要将这两个循环都应用到7000行（这些循环一次应作用于50行）。

第一个循环根据列K中的值在列O中分配值1或0。

然后，第二个循环向列O中不包含0的每个单元格加1，直到列O中的50个单元格数组的总和等于64。

Sub assign_values()

        For i = 2 To 51

            If Cells(i, "K").Value > 0 Then

               Cells(i, "O").Value = 1
               Else
               Cells(i, "O").Value = 0

          End If

      Next i

        For i = 2 To 51

            If Application.WorksheetFunction.Sum(Range("O:O")) = 64 Then Exit Sub
            Cells(i, "O").Value = Cells(i, "O").Value + 1

        Next i

    End Sub

同样，此循环对于前50行也适用。但是，我似乎无法弄清楚如何将此循环应用于下一个7000行。

你们对我有很大的帮助，我感谢您的回答。

谢谢

G

Answer 1

Sub assign_values()

    Const BLOCK_SZ As Long = 50
    Dim rng, c, tot

    Set rng = Range("O2").Resize(BLOCK_SZ, 1) '<< first block of 50 rows

    'keep going while there's content in Col K (you may need to adjust
    '  where you check for content)
    Do While Application.CountA(rng.Offset(0, -4)) > 0

        For Each c In rng.Cells
            c.Value = IIf(c.Offset(0, -4).Value > 0, 1, 0) 'based on ColK
        Next c

        tot = Application.Sum(rng) '<< only need this once, then keep count
        For Each c In rng.Cells
            If tot < 64 Then
                c.Value = c.Value + 1
                tot = tot + 1
            Else
                Exit For
            End If
        Next c

        Set rng = rng.Offset(BLOCK_SZ, 0) '<< next block of cells
    Loop

End Sub

如何重复循环直到电子表格结束？

1 个答案: