Do-while循环未正常运行

Question

我的Excel VBA编码存在问题。

我想让一个编码可以在一定条件下将数据从一张纸复制到另一张纸。单元格中的数据仅为0或1。

Sheet1中的数据有近千行。我只想从Sheet1到Sheet 2获取15个随机数据行。必须满足的标准是每列包含至少2或3个（1）。我认为编码是正确的，但是当它执行时，数据不会停止运行。我该如何解决这个问题？

Private Sub CommandButton1_Click()

Randomize 'Initialize Random number seed 'for sheet 1
Dim MyRows() As Integer    ' Declare dynamic array.
Dim numRows As Integer
Dim percRows As Integer
Dim nxtRow As Integer
Dim nxtRnd As Integer
Dim chkRnd As Integer
Dim copyRow As Integer
Dim i As Integer
Dim j As Integer
Dim clmttl1 As Integer
Dim r As Integer

Dim k As Integer
Dim clmttl2 As Integer
Dim ClmTtl As Integer

numRows = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Get 20% of that number
   percRows = 15

Dim claimTotalCheck As Boolean

claimTotalCheck = True
    Do While claimTotalCheck
        ReDim MyRows(percRows)
        For nxtRow = 1 To percRows
getNew:
            'Generate Random number
            nxtRnd = Int((numRows) * Rnd + 1)

            'Loop through array, checking for Duplicates
            For chkRnd = 1 To nxtRow
                'Get new number if Duplicate is found
                If MyRows(chkRnd) = nxtRnd Then GoTo getNew
            Next
            'Add element if Random number is unique
            MyRows(nxtRow) = nxtRnd
        Next

        For copyRow = 1 To percRows
            Sheets(1).Rows(MyRows(copyRow)).Copy _
            Destination:=Sheets(2).Cells(copyRow, 1)

        Next

        claimTotalCheck = False
        i = 1

        Do While i < 43
            ClmTtl = 0

            For copyRow = 1 To percRows
                ClmTtl = ClmTtl + Sheets(2).Cells(copyRow, i).Value
            Next

            If ClmTtl < 2 Then
                claimTotalCheck = True
            End If
            i = i + 3
        Loop

        k = 2
        Do While k < 43
            clmttl1 = 0

            For copyRow = 1 To percRows
                clmttl1 = clmttl1 + Sheets(2).Cells(copyRow, k).Value
            Next

            If clmttl1 < 3 Then
                claimTotalCheck = True
            End If
            k = k + 3
        Loop

        j = 3
        Do While j < 43
            clmttl2 = 0

            For copyRow = 1 To percRows
                clmttl2 = clmttl2 + Sheets(2).Cells(copyRow, j).Value
            Next

            If clmttl2 < 2 Then
                claimTotalCheck = True
            End If
            j = j + 3
        Loop
    Loop

End Sub

Answer 1

您可能没有43列。请更改values(@sonvinid,@particulars .... etc. 循环的beggings，例如：

Do While

到

Do While i < 43

和Do While i < Sheets(2).Cells(1, Columns.Count).End(xlToLeft).Column 以及k相同。