Do-while-Schleife nicht richtig ausgeführt

Question

Ich habe ein Problem mit Excel-VBA-Codierung.

Ich möchte, dass eine Kodierung Daten mit bestimmten Bedingungen von einem Blatt auf ein anderes Blatt kopieren kann. Daten in Zellen sind nur 0 oder 1.

Daten in Sheet1 hat fast tausend Zeilen. Ich möchte nur 15 zufällige Zeilen von Daten von Sheet1 zu Sheet 2 nehmen. Die Kriterien, die erfüllt werden müssen, ist, dass jede Spalte mindestens 2 oder 3 (1) enthält. Ich denke, die Codierung ist korrekt, aber wenn es ausgeführt wird, hören die Daten nicht auf zu laufen. Wie kann ich dieses Problem lösen?

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

Sie haben wahrscheinlich nicht 43 Spalten. Bitte ändern beggings von Do While Schleifen, zum Beispiel:

Do While i < 43 

zu

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

und das gleiche gilt für k und j.