do while loop in excel vbaエラー

Question

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

1つのコードを作成して、あるシートから特定の条件のシートにデータをコピーすることができます。フォームバイナリで私のデータ。

sheet1のデータは、ほぼ1000行あります。私はちょうどシート1からシート2に15ランダムな行のデータを取るしたいと思います。満たさなければならない基準は、各列が列の合計が3であるということです。それが満たされなければ、他のデータは取り込めません。 ClmTtlが3にならなくなるまでループしたいのですが、どうすれば修正できますか？ 私を助けてください。または私は他の方法で行うことができますか？

Randomize 'Initialize Random number seed 
Dim MyRows() As Integer ' Declare dynamic array. 
Dim numRows, percRows, finalClm, nxtRow, nxtRnd, chkrnd, copyRow As Integer 
'Application.Calculation = xlCalculationManual 
'Application.ScreenUpdating = False 
'Application.EnableEvents = False 
'Determine Number of Rows in Sheet1 Column A 
    numRows = Sheets(1).Cells(Rows.count, "A").End(xlUp).Row 

'Get 20% of that number 
    percRows = 15 

Dim clm, ClmTtl As Integer 

'Allocate elements in Array 

ReDim MyRows(percRows) 

'Create Random numbers and fill array 
Do While ClmTtl <> 3 
    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 clm = 1 To 5 
    ClmTtl = 0 
    For copyRow = 1 To percRows 
     ClmTtl = ClmTtl + Sheets(1).Cells(MyRows(copyRow), clm).Value 
    Next   
    Next 
Loop 

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

'Application.Calculation = xlCalculationAutomatic 
'Application.ScreenUpdating = True 
'Application.EnableEvents = True 
End Sub 

Answer 1

デン寺が正しいこと、そしてあなたが本当に独立変数を暗くする必要がありますが、ここでの本当の問題は、のロジックである：これはClmTtlたびにクリア

For clm = 1 To 5 
    ClmTtl = 0 

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

Next 

あなたが今計算した合計で何もせずに。したがって、選択した最後の列のみをチェックしています。総計のいずれかが3でない場合にトリガーされるループ内のチェックを追加する必要があります。ループにはWhileループがあります。

doループを実行するたびにMyRowsをクリアしないので、初めて失敗すると毎回失敗します。

あなたのループのようなものとして良いかもしれない：

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 

     claimTotalCheck = False 
     For clm = 1 To 5 
      ClmTtl = 0 

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

      If ClmTtl <> 3 Then 
       claimTotalCheck = True 
      End If 
     Next 
    Loop 

Answer 2

EDIT：@bobajobは、あなたの問題が何であるかに関して、より具体的な答えを持っています。

エラーの詳細がわからない場合は、完全な回答を得ることができない場合がありますが、コードに重大な問題があることは間違いありません。

Dimあなたの声明は、あなたが行っているとは思っていません。

たとえば、Dim numRows, percRows, finalClm, nxtRow, nxtRnd, chkrnd, copyRow As Integerは、7つの異なる整数変数を作成しません。 6つの異なるバリアント変数と1つの整数変数を作成します。

すべての宣言を分けて、それをそれぞれの行に入れてそこから取り出してください。

ので、同様：

Dim numRows As Integer 
Dim percRows As Integer 
...