ループエラー、レコードが多すぎます

Question

発芽テスト用の複製の追加を自動化するためにAccess VBAコードを書き込もうとしていました。

基本的には、Reps（NoofReps）の総数とrep（RepSize）あたりのシード数（たとえば50個のシード）を入力するフォームがあります。追加された各レコードについて、自動的に各担当者のレコードを追加し、担当者番号を計算します（つまり、4人の担当者がいる場合は、1〜4人の担当者が4つのレコードを追加する必要があります） 。

私はこのフォーラムなどの情報に基づいてさまざまなループを試してきましたが、生成するレコードの数にはまだ誤りがあります。私は「Do while」と「Do Until」の両方を試しましたが、どちらの場合も同じ結果が得られます。

誰かが私が間違っている場所を教えてもらえますか？2人の担当者が2人、3人が246人、4人が30,000人いるとします。

コードを修正しようとすると、iNoofRepsのコードに担当者の番号を手動で入力するようになったので、エラーはフォームにではなくコードに記載されています。

Private Sub CmdAddReps3_Click() 
Dim iRepNo As Integer ' stores the current value in the series 

'Open the table 
Set db = CurrentDb() 
Set rstGReps = db.OpenRecordset("tblGReplicates") 

' Initialise the variables 
iRepNo = 1 
iNoofReps = 3 'iNoofReps = Me.txtNoofReps 

' Add the records using a loop 
    rstGReps.movefirst 

Do 'Until rstGReps("RepNo") = (iNoofReps + 1) ' always want to include at least 1 repNo 

rstGReps.AddNew 
rstGReps("GTestID") = Me.GTestID 
rstGReps("RepNo") = iRepNo 
rstGReps("NoofSeed") = Me.txtNoOfSeeds 

' Calculate the next RepNo value in the loop 
iRepNo = iRepNo + 1 
rstGReps.Update 
rstGReps.moveNext 

Loop Until rstGReps("RepNo") = (iNoofReps) + 1 ' so that the loop includes the final repNo. 

MsgBox "Finished Looping" 
rstGReps.Close 

Set rstGReps = Nothing 
Set db = Nothing 

End Sub 

何か助けてください！

Answer 1

あなたはここで次のように移動しています：rstGReps.moveNextそして、次に移動した後にrstGReps("RepNo") = (iNoofReps) + 1を比較しているので、空のレコードになり、常にfalseとなります。

Loop Until iRepNo = (iNoofReps) + 1これを修正する必要がある場合は、レコードセットを参照する必要がなくなります。このレコードセットは、参照するときにすでに次のレコードに設定されています。

また、ちょうどこのラインを排除することによって、それを修正することができます：rstGReps.AddNew以来

rstGReps.moveNext

はすでにあまり意味がありません、レコードを追加した後に前方に移動し、新しい空白のレコードにレコードセットを移動します。削除する場合は、+ 1をLoop Until rstGReps("RepNo") = (iNoofReps) + 1

に削除することをおすすめします。