Do-while 루프가 제대로 실행되지 않습니다.

Question

Excel VBA 코딩에 문제가 있습니다.

특정 조건에서 한 시트의 데이터를 다른 시트로 복사 할 수 있도록 만들고 싶습니다. 셀의 데이터는 0 또는 1입니다.

Sheet1의 데이터에는 거의 천 개의 행이 있습니다. 난 그냥 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 

k 및 j에 대한

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

과 같은

합니다.