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

質問

詰まってしまったので質問させていただきます。

登録番号の空き番号を求めることが出来るクエリを使い空いている番号を埋めたいと思います。

個人Ｔ…テーブル。空き番号をもつ"登録番号"フィールドと空き番号がない綺麗な"連番"フィールドを持つ

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」がエラーになってしまいます。

書き方自体が悪いのはものすごく分かるのですが・・・
どこを直したら正常に空き番号を埋めることができるでしょうか？

回答No.7

30246kiku · ベストアンサー

＃１、＃４、＃６です

> 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
でエラーは消えると思います。

お礼

こちらもお礼から失礼します。
今Sample7を実行しようと細かく確認していたところ
Sample6 では、個人Tに振った連番最大値まで登録番号のみを追加登録します。
重複した部分はエラーとなりますが、On Error Resume Next で処理を続けます。
とありますが
Sample6を実行すると重複した部分はエラーにはならず登録番号が作成されていました。ZZZZ0003が空き番号だとすると
ZZZZ0001
ZZZZ0001
ZZZZ0002
ZZZZ0002
ZZZZ0003
ZZZZ0004
ZZZZ0004
この様になってしまいました。
エラーではなく普通に作成されてしまうのはなぜでしょうか？

補足

ご回答ありがとうございます。
サンプル６見事に動作できました。ありがとうございます

>・注文Tの置き換え（連番→登録番号）実行
に関しては、以前に教えていただいた
Private Sub Sample5()
　　Dim sSql As String

　　sSql = "UPDATE 注文T INNER JOIN 個人T ON 注文T.登録番号=個人T.登録番号 SET 注文T.連番 = 個人T.連番;"
　　CurrentProject.Connection.Execute sSql
End Sub

を活用していけるでしょうか？
先に補足として書き込みしてしまいますが、この後調べてみて何かわかりましたら、すみませんがまたお礼欄に書き込ませていただきます。

回答No.16

30246kiku

> 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さん、回答してくれたみなさんありがとうございました。

回答No.15

30246kiku

> 了解しました。
これはご自身で納得してからにしてください。
（私がすべてを把握できていると思ったら間違いです）

> Private Sub Sample77()ですが、すごい早いです！５分かかりませんでした。
> しかも進行状況もしっかり出ました！

内容も大丈夫だったでしょうか。

お礼

お礼から失礼します。

Public Sub Sample()
Dim DB As Database
Dim SQL As String

SQL = "DELETE 登録番号 FROM 個人T WHERE > Right(DMax("連番", "個人T"), 8) Like "ZZZZ";"
Set DB = CurrentDb
DB.Execute SQL
End Sub

調べて書いてみるとこのようなコードになるのですが、
どうしてもエラーになってしまいます・・・
SELECTで探してきてDELETEとかできるんでしょうか？

補足

ご回答ありがとうございます。
>これはご自身で納得してからにしてください。
頭では分かっているのですがいざコードにするとエラーばかりです・・・

>内容も大丈夫だったでしょうか。
はい、データシート上で確認しかまだできていないですが、問題なく移動できているようです。

回答No.14

30246kiku

> ☆３を追加して行ってみたところ
> 「要求された名前、または序数に対応する項目がコレクションで見つかりません」となってしまい

☆３追加前はどうだったのでしょう。
本来の動きには関係ない追加だと思うのですが。
（もともと動いていなかった？）

> ちなみにこの作業のレコードの削除は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

補足

ご回答ありがとうございます。
>☆３追加前はどうだったのでしょう。
>本来の動きには関係ない追加だと思うのですが。
☆３追加前では１時間ほど動作させていましたら終了させることができました。
実際のデータベースだとPC内部での処理より遅いのでこれ以上にかかると思われるので進んでいる状況が見えたら・・・と思っていました。

>登録番号が　> Right(DMax("連番", "個人T"), 8)でかつ ZZZZ で始まるものが対象だと思います。
了解しました。

Private Sub Sample77()ですが、すごい早いです！５分かかりませんでした。
しかも進行状況もしっかり出ました！
改善次第でここまで変わってしまうのですね・・・
本当にありがとうございました！
完全に完了しましたらお礼をさせていただきます。

回答No.13

30246kiku

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 登録番号;"

補足

ご回答ありがとうございます。
☆３を追加して行ってみたところ
「要求された名前、または序数に対応する項目がコレクションで見つかりません」となってしまい
>　　　　rs.Filter = "[連番] = 'XXXX" & rsUP("登録番号") & "'"
この部分が指定されてしまいます。
イミディエイトには「１件目　ZZZZ0001」で止まってしまいます。

ちなみにこの作業のレコードの削除はDELETEで問題ありませんか？
指定は
>=個人T最大値
のような感じで

回答No.12

30246kiku

申し訳ありません。
> 重複した部分はエラーとなりますが、

個人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

お礼

お礼欄から失礼します。
postgreSQL側のテーブルではriyou_idはやはり主キーでした
postgreSQLかわテーブルをaccess側にコピーするときに主キーは消えてしまっていたようです。
主キーにしてからSample6を実行したところ空き番号にのみ登録されていました。ご迷惑おかけしました。
今はテストテーブルで行っていますが本番のテーブルは主キー有りなのでSample6のままいこうと思います。

因みに３０分で１０００件ほど移動できていたようです。

補足

おはようございます。ご回答ありがとうございます。
なるほど、主キーであれば先ほどのコードのままで大丈夫なんですね
確認してみます。
こちらで教えていただいたものも実行してみます。

ちなみにSample7なのですが大量データのやり取りするために時間がかかりそうな気がするのですが(今No.7で教えていただいたコードのまま動かして３０分たっています)

１００件や５００件に１回ぐらいの間隔で写し終ったという報告のメッセージボックスを出すことは可能でしょうか？

回答No.11

ple_mania

こんばんは。
>これは最終的には注文Ｔの連番を作り上げる作業でしょうか？
>個人Ｔの登録番号の空き番号をうめるものではない？

その通りです。前回のご質問の中で個人Ｔで登録番号に対して
採番しなおすところまではできている、という前提があります。

イメージした全体の作業としては
（１）「個人Ｔ」の「連番」をつくる
（２）「注文Ｔ」を洗い替える
（３）「個人Ｔ」を洗い替える
という流れを考えてみました。このうち、ご提示したのは（２）
の部分です。中間Ｔを設けてからそれぞれのテーブルを更新すると
さらにスッキリです。ただ、VBAなのでコードが増えると時間も
かかるわけですが。

かなりうまく進んでいらっしゃるようなので、自分はここまでに
しておきます。頑張ってくださいね。

お礼

ご回答ありがとうございます。
いろんな書き方を見るのも勉強だと思うので回答いただけてうれしいです
流れはだいたいはそうなりますよね
私の場合抜け抜けの説明なのでみなさんに伝えるところからすでに苦労していますが・・・(汗)

うまくできているのは回答してくださっているみなさんのおかげです
本当にありがとうございます。
明日には完成したいと思います

回答No.10

30246kiku

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

sSql = "UPDATE 注文T SET 注文T.登録番号 = 注文T.連番 WHERE 注文T.登録番号 LIKE 'ZZZZ%';"

にしてみてください。

※ 個人Tの連番では、登録番号が　"ABCD" 系の場合、NULLまたは "" になっていますよね。
であれば、そのまま Sample7 を実行してもOKと思います。

お礼

お礼から失礼します。
>Sample7では綺麗に空き番号を個人Ｔ連番の最大値をとって埋めてもらえました。
間違えました！Sample6の間違いでした！
>その後にSample8の実行結果も報告させていただきます。
これがSample7でした！
これからNo.10のコードとSample7をやってみたいと思います

補足

ご回答ありがとうございます。
ＮＯ.９の回答もこちらで補足させていただきます。

>sSql = "UPDATE 注文T SET 注文T.登録番号 = 注文T.連番 WHERE 注文T.登録番号 LIKE 'ZZZZ%';"

なるほど、WHERE部分で抽出できるのですね。もっと基本部分から勉強しなくちゃ・・・

>・・・.Execute では、sSql の内容しか処理しないので、
>rs.Source の設定は無意味です。
>Execute は、それで完結する、更新/挿入/削除クエリの類に限られます。
こちらもなんとなくですが理解できました。
区別が完璧にできないとダメですね

>※ 個人Tの連番では、登録番号が　"ABCD" 系の場合、NULLまたは "" になっていますよね。
そのとおりです。いつも説明が足りず30246kikuさんやみなさんに負担かけてしまって申し訳ありません。
Sample7では綺麗に空き番号を個人Ｔ連番の最大値をとって埋めてもらえました。
後はNo.10で教えていただいたコードで注文Ｔ連番のNullは注文Ｔ登録番号には写さずにZZZZ%でひっかかるもののみ注文Ｔ登録番号に写せれば問題ないですね。
明日朝早速試して見ます
その後にSample8の実行結果も報告させていただきます。

回答No.9

30246kiku

> 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 は、それで完結する、更新/挿入/削除クエリの類に限られます。

> 実際は固有な登録番号は空白で埋められてしまいます。
このところも？？？です

回答No.8

30246kiku

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

単純に
sSql = "UPDATE 注文T SET 注文T.登録番号 = 注文T.連番;"
でいいと思います。

補足

ご回答ありがとうございます。
sSql = "UPDATE 注文T SET 注文T.登録番号 = 注文T.連番;"
で確かに移すことは出来るのですが、ZZZZではない固有の登録番号ABCDなどが
空白の状態になってしまうと思われます。
なのでSELECTで抽出したいのですが、うまくいきません。
Private Sub Sample8()

Dim rs As New ADODB.Recordset
Dim sSql As String

rs.Source = "SELECT " & 連番 & " FROM " & 注文T & _
" WHERE " & 登録番号 & " LIKE 'ZZZZ%' ORDER BY " & 登録番号 & ";"
sSql = "UPDATE 注文T SET 注文T.登録番号 = 注文T.連番;"
CurrentProject.Connection.Execute sSql

End Sub

この様な形になるのではないか・・・
とは思うのですが、実際は固有な登録番号は空白で埋められてしまいます。
うまく抽出することはできますでしょうか？

回答No.6

30246kiku

＃１、＃４です

言われていたことがわかってきました。

テーブル　受注Tと個人Tにリレーションが設定されているのでしょうか。
（確かに、参照整合性が付いているとエラーになりますね：Access単体で）

1度リレーション設定を解除し、各テーブル単位で更新処理後、再度リレーションを設定してみてください。

※ ご質問の趣旨は、

個人Ｔ　　　　　個人Ｔ
登録番号　　　　連番
ZZZZ0001　　　　ZZZZ0001
ZZZZ0003　　　　ZZZZ0002
ZZZZ0006　　　　ZZZZ0003
ZZZZ0007　　　　ZZZZ0004
ZZZZ0009　　　　ZZZZ0005

とあったとき、2, 4, 5, 8 の登録番号を追加して・・・
というものだったのかと思いますが、

その処理をしたとして、注文Tは連番で置き換えができると思います。が、
個人Tを置き換える処理で苦労すると思います。

３ → ２に置き換える時や、６ → ３に置き換える時など
２を追加する時に３の情報で作っておけばよいとは思いますが、
６を３にする時って・・・

お礼

お礼からで失礼します。
SQL側でやはりテーブル同士がくっついているようです。
なのでやはり個人Ｔの登録番号の空き番号をうめて注文Ｔの登録番号を移動させ、
個人Ｔの連番を元に個人Ｔの登録番号を変えるしかありませんよね

補足

ご回答ありがとうございます。
そうです、リレーションシップでお互いをくっつけていました。

趣旨としましては、30246kikuさんの仰るとおりの作業になると思っていました。最小値の方から順に入れ替えを行えば・・・
と思っていたのですが

>３ → ２に置き換える時や、６ → ３に置き換える時など
>２を追加する時に３の情報で作っておけばよいとは思いますが、
>６を３にする時って・・・

３を切り取って２に上書き、６切り取って３上書きとずっと繰り返しが
出来ないものかと思っていました。
そうとう大変な動作だとは思うのですがこれしかないような気がして・・・

リレーションシップを削除してからデータシート上で１つ変更してみようとしました。
ですが、同じく更新に失敗しました。とでてしまいました。
postgresSQL側でもリンクテーブルのようなものでつながれている？のかもしれません