クエリで求めた空き番を登録したい

Question

詰まってしまったので質問させていただきます。

登録番号の空き番号を求めることが出来るクエリを使い空いている番号を埋めたいと思います。

個人Ｔ…テーブル。空き番号をもつ"登録番号"フィールドと空き番号がない綺麗な"連番"フィールドを持つ

ZZZZ空き番号抽出クエリ…"登録番号"の空き番号を昇順で並べた"仮想ID"がある

Private Sub Sample6()

    Dim Db As DAO.Database
    Dim rs As DAO.Recordset
    Dim i As Variant
    Dim J As Variant
    
    
    Set Db = CurrentDb
    Set rs = Db.OpenRecordset("個人Ｔ")
    
        J = Right(DMax("連番", "個人Ｔ"), 4)
        i = 0
        
    While i < J

        rs.AddNew
        i = DMin("仮想ID", "ZZZZ空き番号抽出クエリ")
→→    rs(登録番号) = "ZZZZ" & i
        rs.Update
        rs.MoveNext
       
    Wend
   
End Sub

これで実行すると「このコレクションには項目がありません。」
と「rs(登録番号) = "ZZZZ" & i」がエラーになってしまいます。

書き方自体が悪いのはものすごく分かるのですが・・・
どこを直したら正常に空き番号を埋めることができるでしょうか？

30246kiku · Accepted Answer

＃１、＃４、＃６です


> postgresSQL側でもリンクテーブルのようなものでつながれている？
すみません。こちらの方はわかりません。

> ３を切り取って２に上書き、６切り取って３上書きとずっと繰り返しが
リレーションが設定されたままだと、切り取りできないような気もします。

以下記述の実行順として、参照整合性が設定された環境下でエラーは出ませんでした。
・Sample6実行
・注文Tの置き換え（連番→登録番号）実行
・Sample7実行
（・個人Tから不要部分を削除）


以下 Sample6 では、個人Tに振った連番最大値まで登録番号のみを追加登録します。
重複した部分はエラーとなりますが、On Error Resume Next で処理を続けます。

Private Sub Sample6()
　　Dim rs As New ADODB.Recordset
　　Dim i As Integer
　　Dim j As Integer

　　On Error Resume Next
　　j = CInt(Right(DMax("連番", "個人T"), 4))
　　rs.Open "個人T", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic

　　For i = 1 To j
　　　　rs.AddNew
　　　　rs("登録番号") = "ZZZZ" & Format(i, "0000")
　　　　rs.Update
　　Next
　　rs.Close
End Sub


以下 Sample7 では、個人Tの登録番号と連番の関係を使い、登録番号昇順で小さい方から、既に設定している値をコピーする方法となります。
個人Tの連番は１２文字ということから、コピー先登録番号から連番を生成し、その連番になろうとしているものをコピー元とします。（☆１部分）
☆２では、コピーしないフィールド名を記述します。
（オートナンバーフィールドがあれば、それも除外対象）
Sample7終了後、連番最大値以降の登録番号のレコードを削除すれば、最終形が出来上がると思います。

Private Sub Sample7()
　　Dim rs As New ADODB.Recordset
　　Dim rsUP As New ADODB.Recordset
　　Dim sSql As String
　　Dim sName As String
　　Dim i As Integer

　　sSql = "SELECT * FROM 個人T ORDER BY 登録番号;"
　　rs.Open sSql, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
　　rsUP.Open sSql, CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
　　While (Not rsUP.EOF)
　　　　rs.Filter = "[連番] = 'XXXX" & rsUP("登録番号") & "'" '☆１
　　　　If (Not rs.EOF) Then
　　　　　　For i = 0 To rsUP.Fields.Count - 1
　　　　　　　　sName = rsUP.Fields(i).Name
　　　　　　　　Select Case sName
　　　　　　　　　　Case "登録番号", "連番" '☆２
　　　　　　　　　　Case Else
　　　　　　　　　　　　rsUP(sName).Value = rs(sName).Value
　　　　　　　　End Select
　　　　　　Next
　　　　　　rsUP.Update
　　　　End If
　　　　rsUP.MoveNext
　　Wend
　　rs.Close
　　rsUP.Close
End Sub


※ 登録番号と連番の数字が一緒（コピー不要）の場合でも無条件に行います

※ 個人Tのレコード数分処理します
　（登録番号の数字が連番最大値以降になったら処理をやめる等変更あると思います）
　（時間はかかると思いますが、このままでも）

※ 処理後、連番フィールドの内容は意味のないものになってしまいます。


※※ データはバックアップしてからに


※ 余談
> →→ rs(登録番号) = "ZZZZ" & i
↓
rs("登録番号") = "ZZZZ" & i
でエラーは消えると思います。

30246kiku · Answer

> SQL = "DELETE 登録番号 FROM 個人T WHERE > Right(DMax("連番", "個人T"), 8) Like "ZZZZ";" 
↓
SQL = "DELETE * FROM 個人T WHERE (登録番号 > Right(DMax(""連番"", ""個人T""), 8)) AND (登録番号 Like 'ZZZZ*');"

"DELETE ・・・;" 部分を、クエリのSQLビューで貼り付け、データシートビューで見ると削除対象レコードを確認できると思います。
（上記SQLへの代入では、文字列内の " は、"" の指定になります）

わからなくなった時には、１度クエリのSQLビューに張り付けてみたり、デザインビューの指定方法を確認してみたり、使えるものは使っていきましょう。
クエリのデザインビューで設定したものが、SQLでどう書くのかなど、いろいろいじってみてください。

30246kiku · Answer

> 了解しました。
これはご自身で納得してからにしてください。
（私がすべてを把握できていると思ったら間違いです）

> Private Sub Sample77()ですが、すごい早いです！５分かかりませんでした。
> しかも進行状況もしっかり出ました！

内容も大丈夫だったでしょうか。

30246kiku · Answer

> ☆３を追加して行ってみたところ
> 「要求された名前、または序数に対応する項目がコレクションで見つかりません」となってしまい

☆３追加前はどうだったのでしょう。
本来の動きには関係ない追加だと思うのですが。
（もともと動いていなかった？）


> ちなみにこの作業のレコードの削除はDELETEで問題ありませんか？
> 指定は
> >=個人T最大値
> のような感じで

登録番号が　> Right(DMax("連番", "個人T"), 8)でかつ ZZZZ で始まるものが対象だと思います。



個人Tの連番フィールドにインデックスあり（重複あり）を設定し、
以前の Sample7 を以下に変更すると、少しは速くなるかも？

Private Sub Sample77()
　　Dim rs As ADODB.Recordset
　　Dim rsUP As New ADODB.Recordset
　　Dim i As Integer
　　Dim iCount As Long

　　iCount = 0
　　rsUP.Source = "SELECT * FROM 個人T WHERE 登録番号 LIKE 'ZZZZ%' ORDER BY 登録番号;"
　　rsUP.Open , CurrentProject.Connection, adOpenKeyset, adLockOptimistic
　　Set rs = rsUP.Clone(adLockReadOnly)
　　While (Not rsUP.EOF)
　　　　iCount = iCount + 1
　　　　Debug.Print iCount & " 件目 " & rsUP("登録番号")
　　　　rs.Filter = "[連番] = 'XXXX" & rsUP("登録番号") & "'"
　　　　If (Not rs.EOF) Then
　　　　　　For i = 0 To rsUP.Fields.Count - 1
　　　　　　　　Select Case rsUP.Fields(i).Name
　　　　　　　　　　Case "登録番号", "連番"
　　　　　　　　　　Case Else
　　　　　　　　　　　　rsUP.Fields(i).Value = rs.Fields(i).Value
　　　　　　　　End Select
　　　　　　Next
　　　　　　rsUP.Update
　　　　End If
　　　　rsUP.MoveNext
　　Wend
　　rs.Close
　　rsUP.Close
　　Set rs = Nothing
End Sub

30246kiku · Answer

Sample7 の一部分を抜粋したもので、☆３部分を追加しています。
Sample7 を実行する前に、表示でイミディエイトウィンドウを表示しておきます。
何件目を処理しているか、イミディエイトウィンドウに表示されます。

　　Dim i As Integer
　　Dim iCount As Long　　'☆３

　　iCount = 0　　'☆３
　　sSql = "SELECT * FROM 個人T ORDER BY 登録番号;"
　　rs.Open sSql, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
　　rsUP.Open sSql, CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
　　While (Not rsUP.EOF)
　　　　iCount = iCount + 1　　'☆３
　　　　Debug.Print iCount & " 件目 " & rsUP("登録番号")　　'☆３
　　　　rs.Filter = "[連番] = 'XXXX" & rsUP("登録番号") & "'"


※
　　sSql = "SELECT * FROM 個人T ORDER BY 登録番号;"
この部分、ZZZZ に絞り込んだら少しは速くなると思います。
　　sSql = "SELECT * FROM 個人T WHERE 登録番号 LIKE 'ZZZZ%' ORDER BY 登録番号;"

30246kiku · Answer

申し訳ありません。
> 重複した部分はエラーとなりますが、

個人Tの登録番号は主キー（インデックスあり、重複なし）と勝手に解釈していました。


データは戻りますよね。

Sample6 を以下に変更してください。

Private Sub Sample66()
　　Dim rs As New ADODB.Recordset
　　Dim i As Integer
　　Dim j As Integer
　　Dim k As Integer

　　j = CInt(Right(DMax("連番", "個人T"), 4))
　　rs.Source = "SELECT 登録番号 FROM 個人T WHERE 登録番号 LIKE 'ZZZZ%' ORDER BY 登録番号;"
　　rs.Open , CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic

　　i = 1
　　While ((Not rs.EOF) And (i <= j))
　　　　k = CInt(Right(rs("登録番号"), 4))
　　　　While ((i < k) And (i <= j))
　　　　　　rs.AddNew
　　　　　　rs("登録番号") = "ZZZZ" & Format(i, "0000")
　　　　　　rs.Update
　　　　　　i = i + 1
　　　　Wend
　　　　rs.MoveNext
　　　　i = i + 1
　　Wend
　　rs.Close
End Sub

ple_mania · Answer

こんばんは。
>これは最終的には注文Ｔの連番を作り上げる作業でしょうか？
>個人Ｔの登録番号の空き番号をうめるものではない？

その通りです。前回のご質問の中で個人Ｔで登録番号に対して
採番しなおすところまではできている、という前提があります。

イメージした全体の作業としては
（１）「個人Ｔ」の「連番」をつくる
（２）「注文Ｔ」を洗い替える
（３）「個人Ｔ」を洗い替える
という流れを考えてみました。このうち、ご提示したのは（２）
の部分です。中間Ｔを設けてからそれぞれのテーブルを更新すると
さらにスッキリです。ただ、VBAなのでコードが増えると時間も
かかるわけですが。

かなりうまく進んでいらっしゃるようなので、自分はここまでに
しておきます。頑張ってくださいね。

30246kiku · Answer

あ、雰囲気わかりました。

sSql = "UPDATE 注文T SET 注文T.登録番号 = 注文T.連番 WHERE 注文T.登録番号 LIKE 'ZZZZ%';"

にしてみてください。

※ 個人Tの連番では、登録番号が　"ABCD" 系の場合、NULLまたは "" になっていますよね。
であれば、そのまま Sample7 を実行してもOKと思います。

30246kiku · Answer

> sSql = "UPDATE 注文T SET 注文T.登録番号 = 注文T.連番;"
> で確かに移すことは出来るのですが、ZZZZではない固有の登録番号ABCDなどが
> 空白の状態になってしまうと思われます。

実際のデータを列挙してみましょう。（部分的でも良いので）
登録番号 "ABCD" がどのように絡んでいるとか。
最低１０行程度の関連図(?)が必要です。


> rs.Source = "SELECT " & 連番 & " FROM " & 注文T & _
> " WHERE " & 登録番号 & " LIKE 'ZZZZ%' ORDER BY " & 登録番号 & ";"
> sSql = "UPDATE 注文T SET 注文T.登録番号 = 注文T.連番;"
> CurrentProject.Connection.Execute sSql

・・・.Execute では、sSql の内容しか処理しないので、
rs.Source の設定は無意味です。
Execute は、それで完結する、更新/挿入/削除クエリの類に限られます。

> 実際は固有な登録番号は空白で埋められてしまいます。
このところも？？？です

30246kiku · Answer

> を活用していけるでしょうか？

単純に
sSql = "UPDATE 注文T SET 注文T.登録番号 = 注文T.連番;"
でいいと思います。

クエリで求めた空き番を登録したい

＃１、＃４、＃６です

この回答への補足

> SQL = "DELETE 登録番号 FROM 個人T WHERE > Right(DMax("連番", "個人T"), 8) Like "ZZZZ";"

> 了解しました。

この回答への補足

> ☆３を追加して行ってみたところ

この回答への補足

Sample7 の一部分を抜粋したもので、☆３部分を追加しています。

この回答への補足

申し訳ありません。

この回答への補足

こんばんは。

あ、雰囲気わかりました。

この回答への補足

> sSql = "UPDATE 注文T SET 注文T.登録番号 = 注文T.連番;"

> を活用していけるでしょうか？

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング