Access (VBA)

Access VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : Access 2021)
カレントレコードがありませんのエラー修正方法
投稿日時: 24/01/12 16:00:45
投稿者: ぽろんちょ

いつも大変お世話になります。
 
以下のテーブルがあります。本来はPLNoフィールドは空欄になっており、上からCS数を加算して積載数量に達したら、PLNoに番号を付与しています。このような動きができるコードを書いて取り合えずは自分の望むデータを取得できているのですが、最後に「カレントレコードがありません」のエラーが出てしまいます。色々と書き換えたのですが、なかなか回避できません。どなたか回避方法がおわかりになる方いらっしゃいましたら、教えていただけませんでしょうか?宜しくお願い致します。
 
 
在庫内訳テーブル
ID    PLNo    品目コード  ロット    CS数    積載数量
20    1    AAA        -     80     80
21    2    AAA        -     70     80
22    2    AAA       202309    10    80
23    3    AAA       202309    10    80
24    3    AAA       202310    10    80
25    3    AAA       202311    60    80
26    4    AAA       202311    60    80
27    4    AAA       202312    20    80
28    5    AAA       202312    10    80
29    1    BBB        -     100     100
30    2    BBB        -     10     100
31    2    BBB       202309    90    100
32    3    BBB       202309    30    100
33    3    BBB       202310    60    100
34    3    BBB       202311    10    100
35    4    BBB       202311    30    100
36    4    BBB       202312    70    100
37    5    BBB       202312    80    100
 
出荷テーブル
品目コード
AAA
BBB
 
コードは以下になります。
Sub autonumber()
     
    Dim db As Database
    Dim Table1 As Recordset
    Dim Table2 As Recordset
    Dim intCountNumber As Integer
    Dim intTotal As Integer
    Dim intID As Integer
     
    Set db = CurrentDb
     
    Set Table2 = db.OpenRecordset("SELECT * FROM 出荷 ORDER BY 品目コード")
     
    intCountNumber = 0
    intTotal = 0
     
    Do Until Table2.EOF
        Set Table1 = db.OpenRecordset("SELECT * FROM 在庫内訳 ORDER BY ID")
        Do Until Table1.EOF
            intID = Table1!ID
            If Table2!品目コード = Table1!品目コード Then
                If Table1!CS数 = Table1!積載数量 Then
                    intCountNumber = intCountNumber + 1
                    If intID = Table1!ID Then
                        DoCmd.SetWarnings False
                        DoCmd.RunSQL "UPDATE 在庫内訳 SET PLNo=" & intCountNumber & " WHERE ID=" & intID
                        DoCmd.SetWarnings True
                        Debug.Print intCountNumber
                        Debug.Print Table1!ID
                        intID = intID + 1
                    End If
                ElseIf intTotal <= Table1!積載数量 Then
                    intCountNumber = intCountNumber + 1
                        Do Until intTotal = Table1!積載数量
                            If Table2!品目コード <> Table1!品目コード Then
                                Exit Do
                            End If
                            intTotal = intTotal + Table1!CS数
                            If intID = Table1!ID Then
                                DoCmd.SetWarnings False
                                DoCmd.RunSQL "UPDATE 在庫内訳 SET PLNo=" & intCountNumber & " WHERE ID=" & intID
                                DoCmd.SetWarnings True
                                Debug.Print intCountNumber
                                Debug.Print Table1!ID
                                intID = intID + 1
                            End If
                                If intTotal = Table1!積載数量 Then
                                    Exit Do
                                End If
                            Table1.MoveNext
                        Loop
                    intTotal = 0
                End If
            End If
            Table1.MoveNext
        Loop
        intCountNumber = 0
        Table2.MoveNext
    Loop
     
    Table1.Close
    Table2.Close
     
    db.Close
     
End Sub

回答
投稿日時: 24/01/12 16:46:18
投稿者: sk

引用:
本来はPLNoフィールドは空欄になっており、上からCS数を加算して
積載数量に達したら、PLNoに番号を付与しています。

(標準モジュール)
----------------------------------------------------------------
Sub SetNumberByItem()
 
    Dim db As DAO.Database
    Dim qdfStockFilter As DAO.QueryDef
    Dim strSQL As String
         
    Set db = CurrentDb
     
    strSQL = "PARAMETERS [ItemKey] TEXT(255);" & _
             "SELECT * FROM [在庫内訳] WHERE [品目コード]=[ItemKey] ORDER BY [ID];"
    Set qdfStockFilter = db.CreateQueryDef("", strSQL)
     
    Dim rsItems As DAO.Recordset
     
    strSQL = "SELECT * FROM [出荷] ORDER BY [品目コード];"
    Set rsItems = db.OpenRecordset(strSQL, dbOpenSnapshot)
         
    Dim rsStockDetail As DAO.Recordset
    Dim lngCurrentNumber As Long
    Dim lngStockTotal As Long
     
    Do Until rsItems.EOF
         
        With qdfStockFilter
            .Parameters("ItemKey").Value = rsItems![品目コード].Value
            Set rsStockDetail = .OpenRecordset(dbOpenDynaset)
        End With
         
        lngCurrentNumber = 1
        lngStockTotal = 0
         
        Do Until rsStockDetail.EOF
            rsStockDetail.Edit
            rsStockDetail![PLNo].Value = lngCurrentNumber
            rsStockDetail.Update
            lngStockTotal = lngStockTotal + Nz(rsStockDetail![CS数].Value, 0)
            If lngStockTotal >= Nz(rsStockDetail![積載数量].Value, 0) Then
                lngCurrentNumber = lngCurrentNumber + 1
                lngStockTotal = 0
            End If
            rsStockDetail.MoveNext
        Loop
         
        Set rsStockDetail = Nothing
         
        rsItems.MoveNext
    Loop
     
    Set rsItems = Nothing
    Set qdfStockFilter = Nothing
    Set db = Nothing
     
End Sub
----------------------------------------------------------------
 
以上のような処理を実行なさろうとしている、ということでしょうか。

投稿日時: 24/01/15 14:36:50
投稿者: ぽろんちょ

sk様
 
ご返信ありがとうございます。
試してみたところ、エラーもなく欲しいデータを取得することができました。
QueryDefやPARAMETERSなどほとんど使ったことがなかったのですが、
これを機にもう一度勉強してみようと思いました。
 
大変お忙しい中、ありがとうございました。