Do-whileループが正しく実行されていません

Question

Excel VBAコーディングに問題があります。

特定の条件で1つのシートから別のシートにデータをコピーするコードを作成したいと考えています。セル内のデータは0または1です。

Sheet1のデータは、ほぼ1000行あります。私はちょうどSheet1からシート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個の列を持っていません。例えば、Do Whileループのbeggingsを変更してください：

Do While i < 43 

を

Do While i < Sheets(2).Cells(1, Columns.Count).End(xlToLeft).Column 

と同じにkとjのために。