空き番検索でオーバーフロー

Question

同じような現象がなかったので、初心者ではありますが
質問させていただきます

http://okwave.jp/qa447885.html
こちらの質問にあった
ryuu001さん回答の

　◎テーブル名　＝　テーブル1
　◎連番のフィールド名　＝　ID　とし
　◎連番は後から入力した数値が
　　先に入力した数値より
　　小さくなることは無い。
　　（dmaxを使用しているので大丈夫かと思いますが）

Sub test()
Dim Db As Database
Dim Rs As DAO.Recordset
Dim Temp As String
Dim I As Integer

Set Db = CurrentDb()
Set Rs = Db.OpenRecordset("テーブル1")

Rs.MoveFirst
I = 1
Temp = ""
Do Until Rs.EOF = True
Do While I < Rs!ID
Temp = Temp & " " & I
I = I + 1　　　＊１
Loop
Rs.MoveNext
I = I + 1
Loop
Rs.Close
Set Rs = Nothing
Db.Close
Set Db = Nothing
MsgBox "次の数字が抜けています。" & vblf & Temp
End Sub

VBAを利用させていただきました。
ですが「オーバーフローしました」とエラーが出てしまい
デバッグすると＊１の場所で止まっているようでした
これはやはりLoopしているのが原因なんでしょうか

ずっと＋１を繰り返している・・・？

A88No8 · Accepted Answer

こんにちは
＃８です。　的確なアドヴァイスが出来なくてごめんなさい。

>>MsgBox "比較処理中 I=" & Str$(I) & ", Rs!ID=" & Str$(Rs!ID)
>このメッセージボックス部分で「型が一致しません」と出てしまうようです。宣言など>が必要なんでしょうか？
>Str関数？がうまく機能してないのでしょうか・・・

質問者さんがにらんだ通り、当たりです(^^;
STR$()関数は、引数が数値でなくてはならないのですが、「Rs!ID」は
数値ではないため、エラーになりました。

>MsgBox "比較処理中 I=" & Str$(I) & ", Rs!ID=" & Str$(Rs!ID)
>MsgBox "Loop通過 I=" & Str$(I) & ", Rs!ID=" & Str$(Rs!ID)

従って、上記はどちらでも処理が通過するときエラーになります。
片方しかエラーが見つからないのは、たまたまデータが片方を通過
するパターンしかなかったということと理解しています。
ホントにすみませんでした m(__;m 

さて、下記のようにしていただく案と．．

MsgBox "比較処理中 I=" & Str$(I) & ", Rs!ID=" & Rs!ID
MsgBox "Loop通過 I=" & Str$(I) & ", Rs!ID=" & Rs!ID

Str$(Rs!ID) を Str$(J)にする案があります。

MsgBox "比較処理中 I=" & Str$(I) & ", J=" & Str$(J)
MsgBox "Loop通過 I=" & Str$(I) & ", J=" & Str$(J)

どちらでもいいです。プログラムが思ったように動いているかを変数
の値から把握するのが目的ですから。

飛び番がないときは、Loop通過 I=..しか表示されません。
飛び番があったら、比較処理中 I=.. が飛び番の数だけ表示されてか
ら Loop通過 I=.. に移るはずですね。

A88No8 · Answer

こんにちは
＃７です。横入りでごめんなさい。
積極的に変数の内容が意図したように変わっているか見てみましょう。VBAエディタを使いこなせるとステップ実行やウォッチ機能でできるのですが、コードに埋め込む手もあります。

Sub test()
'◆前提条件
'・レコードセットは、ID昇順で得られる。
'・同じ数値のIDはない。
'・IDの最小値は 1 である。
'・IDの最大値は Integerで扱える。
'・フィールド ID は、数値型
'

　Dim Db As Database
　Dim Rs As DAO.Recordset
　Dim Temp As String '抜け番号レポート用文字列バッファ
　Dim I As Integer 'レコード番号カウンタ(1～対象IDすべて)(32767以内)
　Dim J As Integer 'ID番号(数字部分を整数に変換して格納される)

　'●DBからIDのZZZZnnnn 抽出し、IDをキーに昇順ソート
　Set Db = CurrentDb()
　Set Rs = Db.OpenRecordset("SELECT ID FROM テーブル1 WHERE ID LIKE 'ZZZZ*' ORDER BY ID")

　Rs.MoveFirst

　Let I = 1 '1番目のIDからスタートするため、カウンタも1に初期化
　Let Temp = "" 'レポート用バッファは空に初期化

　'■レコードセットの終わりが来るまで Loop
　Do Until Rs.EOF = True
　　　'●IDの ZZZZnnnnの数字部分を切り取る
　　　Let J = CInt(Right(Rs!ID, 4))
　　　'■レコード番号カウンタがID番号よりも小さい(=抜けがある)間Loop
　　　Do While I < J
　　　　　Let Temp = Temp & " " & I '●抜けているレコード番号を記録
　　　　　Let I = I + 1 '●次のID番号と比較する準備
　　　　　MsgBox "比較処理中 I=" & Str$(I) & ", Rs!ID=" & Str$(Rs!ID)
　　　'■
　　　Loop
　　　MsgBox "Loop通過 I=" & Str$(I) & ", Rs!ID=" & Str$(Rs!ID)
　　　Rs.MoveNext
　　　Let I = I + 1 '●次のID番号と比較する準備
　'■
　Loop
　MsgBox "Loop終了(レコードセットの終端に達した)"

　Rs.Close
　Set Rs = Nothing
　Db.Close
　Set Db = Nothing
　MsgBox "次の数字が抜けています。" & vbLf & Temp

End Sub

A88No8 · Answer

横入りでごめんなさい。
＃６のアドヴァイスでトライされたのはよいのですが、古いDOコードが残ったままです(DOは、LOOPとセットで、DO～LOOP文です)。
とりあえず、下記の←印の行を削除して試してみましょう。

Do Until Rs.EOF = True
　　　J = CInt(Right(Rs!ID,4))
　　　Do While I < J
Do While I < Rs!ID　　　←前の2行で置換えるべきステートメントなので削除しないと
Temp = Temp & " " & I
I = I + 1　　　
Loop
　　　msgBox "Loop通過"
Rs.MoveNext
I = I + 1
Loop

30246kiku · Answer

#4 での前提条件に（基本的な条件として）１つ抜けがありました。

・フィールド ID は、数値型


> たとえば個人データならABCD0001。未特定データならZZZZ0001~9999のようになります。

数字部分を分離する必要があります。


未特定データでの修正案１）
IDの右４文字を数値として INUM 名で抽出しておく

・レコードセットを得るSQLを以下

SELECT CInt(Right([ID],4)) AS INUM FROM テーブル1 WHERE ID LIKE 'ZZZZ*' ORDER BY ID;

・Do While I < Rs!ID　→　Do While I < Rs!INUM



未特定データでの修正案２）

・レコードセットを得るSQLを以下

SELECT ID FROM テーブル1 WHERE ID LIKE 'ZZZZ*' ORDER BY ID;

・VBA 記述追加/変更

　Dim J As Integer 宣言追加

　Do Until Rs.EOF = True
　　　Do While I < Rs!ID
↓

　Do Until Rs.EOF = True
　　　J = CInt(Right(Rs!ID,4))
　　　Do While I < J

※ ID の右４文字を数値とする方法は上記のとおりで、５文字目以降という意味合いなら
　　CInt(Mid(○○,5))

※ 個人データであれば、'ZZZZ*' → 'ABCD*'


※　メモ

　Dim I As Integer

　I = 1
　Do While I < AAA '----- (1)
　　I = I + 1
　Loop

上記状態で、(1)の AAA をいろいろ変えた時の動き
・Do While I < 3
　　I が 3 になるまでループ
・Do While I < "3"
　　I が 3 になるまでループ
・Do While I < "A3"
　　型が一致しないエラー
・Do While I < Rs!ID　　　IDはテキスト型で、中身 "A3"
　　I のオーバーフロー

A88No8 · Answer

こんにちは
＃１、＃３です。
＃４さんの適切なご指摘で＃１、３は外していることが明確になりましたので＃１、＃３は無視して下さい。
ごめんなさい。
ただ、「Rs!ID」の正体が気になり始めました。

30246kiku · Answer

なぜオーバーフローしたか分かりませんが、

このコードの前提条件は、以下と思われます。

・レコードセットは、ID昇順で得られる。
・同じ数値のIDはない。
・IDの最小値は　=1　である。
・IDの最大値は Integer で扱える。


> データ数は数字上限でいうと9999です。
> 個人データと未特定データを合わせても２万弱になります。

一度確認されてみてはいかがでしょう。

※
　　Rs.MoveNext
　　I = I + 1　← 次に得られるであろうID値を事前に設定している

A88No8 · Answer

こんにちは
＃１です。勘違いされているようなので．．
>Let I = I + 1 に両方とも変更してみたのですが
>同じくオーバーフローしてしまいました。データ数２万弱ですがこのVBAだと無理なんでしょうか・・・

　いいたかったのは「Let I = I + 1」が変じゃない？ってことなんです。
　外側のDOでレコード(行)をトレースし、内側のDOでフィールド(列)をトレースしているように見える。　Iの目的がデータすべての順序番号なら外側と内側の間にあるLet I=I+1は、不要。
　Iの目的がフィールド順序番号を繰返す目的なら  Let I=1 でフィールド(列)を一巡する内側のDOを抜けた時点で、Iを初期化すべきではないでしょうか？
　あと、Iの目的がデータすべての順序番号なら、多分 integer だと16ビットのような気がするので 65536 の半分（3万ぐらい）までしかカウントできません。
　フィールド×レコードの値が3万以内に入っていますか？

n-jun · Answer

回答ではないですが。

リンク先の回答のコードを使ってみたらオーバーフローしました。
と言ってもその質問者と同じ環境なのかどうかもわかりません。

あとIntegerの範囲を超えたデータ量と言うわけでもないですよね。
⇒Excelでたまに使ってしまい範囲を超えてオーバーフローさせる事もありましたもので。

A88No8 · Answer

こんにちは
　Do Until Rs.EOF = True
　　Do While I < Rs!ID
　　　Temp = Temp & " " & I
　　　Let I = I + 1
　　Loop
　　Rs.MoveNext
　　Let I = I + 1　←外側のループにあるこれが無意味のような(Let I=1 なら納得)。
　Loop

空き番検索でオーバーフロー

こんにちは

この回答への補足

こんにちは

この回答への補足

横入りでごめんなさい。

この回答への補足

#4 での前提条件に（基本的な条件として）１つ抜けがありました。

この回答への補足

こんにちは

この回答への補足

なぜオーバーフローしたか分かりませんが、

この回答への補足

こんにちは

この回答への補足

回答ではないですが。

この回答への補足

こんにちは

この回答への補足

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

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

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

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