• 締切済み

Access VBAで分類別に連番を振る応用

Sub DAO_num()   '分類別連番付加 Dim db As DAO.Database Dim rs As DAO.Recordset Dim fld As DAO.Field Dim fldid As String Dim stSQL As String Dim i As Long '入力開始番号の値を格納 Dim i2 As String '前ゼロ表記の設定値を格納 Dim i3 As String '入力された変数をセーブ Dim recut As Long '連番付加処理カウンタ stSQL = "SELECT * FROM [Vba] ORDER BY [code] , [zip] , [ID]" Set db = CurrentDb() Set rs = db.OpenRecordset(stSQL, dbOpenDynaset) Set fld = rs.Fields("ren") '[ren]フィールドに連番を付加 rs.MoveFirst i = 0 i2 = "" fldid = rs!code i = InputBox("開始番号を入力して下さい。") i3 = i i2 = InputBox("前ゼロ表記の必要桁数を入力して下さい。") Do Until rs.EOF rs.Edit recut = recut + 1 If fldid <> rs!code Then '[code]が変わったら連番を振り直す i = i3 fldid = rs!code Else End If fld = Format(i, i2) rs.Update i = i + 1 rs.MoveNext Loop rs.Close db.Close MsgBox ("【処理終了】" & vbCrLf & "処理件数= " & recut & " 件") End Sub ---------------------------------------------------------------- 質問です。 i = InputBox("開始番号を入力して下さい。") ↑ここで値を入力した後、確認の為のInputBoxを出して値を入力し、最初入力した値と確認用に入力した値が同じなら処理を行う。不正の場合、メッセージを出して強制終了。 という風にカスタマイズしたいのですが、うまくいきません。 どなたかアドバイス宜しくお願い致します。

みんなの回答

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.1

'変数の宣言 Dim i As Long i = InputBox("開始番号を入力して下さい。") If MsgBox("開始番号は " & i & " で宜しいでしょうか?", vbYesNo) = vbNo Then MsgBox ("【いいえ】が選択されましたので、終了します") Exit Sub End If '~以下やりたい処理 再度入力する必要があるのかは不明ですが、確認させればいいのですよね?

swcjb010
質問者

お礼

大変助かりました。 機会があれば是非またアドバイス宜しくお願い致します。 ありがとうございました。

関連するQ&A

  • 条件別に連番を振る方法を教えてください。

    お世話になります。 下記の様な条件による連番をふるマクロを組みたいと考えており、 色々考えてたのですがやり方が分からなく困っています。多少複雑だとは思いますが、すみませんが、詳しい方よろしくお願い致します。 内容として、例えばですが野球チームの選手をランク別にあるコーチに割り当てたいとします。 T_コーチマスタ(テーブルA) ランク  コーチ名  担当数MAX --------------------------------  A    鈴木     2 ←Aランク選手に割り当てたいコーチ  A    橋本     2 ←Aランク選手に割り当てたいコーチ  B    田中     2 ←Bランク選手に割り当てたいコーチ  B    青木     3 ←Bランク選手に割り当てたいコーチ  C    佐藤     2 ←Cランク選手に割り当てたいコーチ (補足:ランク順に昇順しています) T_選手マスタ(テーブルB) ランク   選手名  人数(連番) コーチ名 --------------------------------------------  A     加藤  B     山本  B     渡辺  B     吉田  A     佐々木  A     木村  C     太田 (*得たい結果) ランク   選手名  担当数(連番) コーチ名 --------------------------------------------  A     加藤     1       鈴木  A     佐々木    2       鈴木  A     木村     1       橋本  B     山本     1       田中  B     渡辺     2       田中  B     吉田     1       青木 ※選手ランク(T_選手マスタ)別に、コーチ名と連番を割り当てたいのですが、コーチにも教えられる人数が限られており、担当数MAXまでしか連番をふれません。担当数を超えると次(下)のコーチ(ランク別)に割り当てたいです。担当者MAXがなく一人のコーチが全員分連番をふれればいいのですが・・・。  連番を振るだけのコードだけは分かったのですが、どうすれば上手い具合にできますでしょうか??(SQLで方法がありますか?) '連番のみのコード Sub DAO_numbers() Dim db As DAO.Database Dim rs As DAO.Recordset Dim fd As DAO.Field Dim SQL As String Dim inCount As Integer Set db = CurrentDb() SQL = "SELECT * FROM T_選手マスタ ORDER BY ランク" Set rs = db.OpenRecordset(SQL, dbOpenDynaset) Set fd = rs.Fields("人数") If rs.BOF = False Then rs.MoveFirst inCount = 1 Do Until rs.EOF rs.Edit fd = inCount rs.Update inCount = inCount + 1 rs.MoveNext Loop End If rs.Clone: Set rs = Nothing db.Close: Set db = Nothing End Sub (上記コードは使わないのであれば無視しても構いません。) 以上よろしくお願い致します。

  • アクセスVBA 変数での抽出条件の書きかた

    顧客データテーブルからの抽出です。 変数を使った書き方がわかりません。 よろしくお願いします。 テーブルのレコードには [氏名]:鈴木 [telnum]:0123456789 が存在します。 Private Sub テキスト0_BeforeUpdate(Cancel As Integer) Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("顧客マスタ", dbOpenDynaset) Dim str As String str = "0123456789" rs.Filter = "[telnum] = ' " & str & " ' " Set rs = rs.OpenRecordset MsgBox (rs!氏名) ’←エラーメッセージ”カレントレコードがありません。”が出ます End Sub

  • エラー3011

    パス名もきちんと設定し、データもあっているのですが オブジェクトが存在しないか、名前、パス名が違うと エラーがでてしまいます。どこが違うのでしょうか? Dim db As String Dim db_Mdb As DAO.Database Dim rd_Mdb As DAO.Recordset Dim stSQL As String db = "C:\XXX\VB\kanri.mdb"   'パス名は、アドレスをコピー貼り付けしたので間違いないと思います) ”省略(データベースに接続)” stSQL = "select * from name where bango=0001;" Set rd_Mdb = db_Mdb.OpenRecordset(stSQL, dbOpenTable) お願いしますm(__)m

  • Access VBA 添付型フィールド

    Access VBAで添付型フィールドからファイル名を取りだしたいのですが、どのようにすればいいでしょうか? Private Sub Sample() Dim DB As DAO.Database Dim RS As DAO.Recordset Dim SQL As String   Set DB = CurrentDb SQL_1 = "SELECT * FROM ボランティア情報 ORDER BY 分野 & 団体名読み;" Set RS = DB.OpenRecordset(SQL_1, dbOpenDynaset) With RS   Do While Not .EOF   MsgBox (!写真.FileName)  ←ここでエラーが出ます。 .   MoveNext   Loop End With RS.Close Set RS = Nothing Set MDB = Nothing End Sub

  • アクセス VBAでレコードが追加できない

    お世話になります。 フォームのボタン(コマンド1)をクリックして テーブルにレコードを追加したいのですが、うまくいきません。 SQLの引数value('intNumber')を実数(例えば'3')とかにすると うまく1レコード追加されるのですが、新規レコードとして 連番で追加させたいので困っています。 宜しくお願いします。 Private Sub コマンド1_Click() Dim dbDao As DAO.Database Dim stSql As String Dim intNumber As Integer intNumber = DMax("[管理ID]", "[テーブル名]") + 1 Set dbDao = CurrentDb stSql = "insert into テーブル名 (管理ID,管理2,管理3) values ('intNumber','99999','99999');" dbDao.Execute stSql dbDao.Close: Set dbDao = Nothing End Sub

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

    同じような現象がなかったので、初心者ではありますが 質問させていただきます 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   *1 Loop Rs.MoveNext I = I + 1 Loop Rs.Close Set Rs = Nothing Db.Close Set Db = Nothing MsgBox "次の数字が抜けています。" & vblf & Temp End Sub VBAを利用させていただきました。 ですが「オーバーフローしました」とエラーが出てしまい デバッグすると*1の場所で止まっているようでした これはやはりLoopしているのが原因なんでしょうか ずっと+1を繰り返している・・・?

  • ODBC--リンクテーブル'XXXX'での更新に失敗しました

    同じ現象がなさそうでしたので質問させていただきます。 インポートしたテーブルであれば問題なくレコードの更新が出来るのですが 実際のODBCで繋いだDBでは「ODBC--リンクテーブル'XXXX'での更新に失敗しました」となってしまいます。 DAOとADO両方試してみました。以下のものになります こちらは教えていただいたものです。 Private Sub Sample3() Dim rs As New ADODB.Recordset Dim i As Integer Const フィールド名 As String = "連番" ' ☆1 Const テーブル名 As String = "元テーブル" ' ☆1 Const 抽出 As String = "登録番号" ' ☆1 Const 並び替え As String = "登録番号" ' ☆1 i = 1 rs.Source = "SELECT " & フィールド名 & " FROM " & テーブル名 & _ " WHERE " & 抽出 & " LIKE 'ZZZZ%' ORDER BY " & 並び替え & ";" rs.Open , CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic While (Not rs.EOF) rs(フィールド名) = "ZZZZ" & Format(i, "0000") rs.Update rs.MoveNext i = i + 1 Wend rs.Close End Sub ADOだからダメなのかと思い こちらは教えて頂いたものをDAOにしてみました。 Private Sub Sample3() Dim Db As DAO.Database Dim rs As DAO.Recordset Dim i As Integer Const フィールド名 As String = "連番" ' ☆1 Const テーブル名 As String = "元テーブル" ' ☆1 Const 抽出 As String = "登録番号" ' ☆1 Const 並び替え As String = "登録番号" ' ☆1 i = 1 Set Db = CurrentDb() Set rs = Db.OpenRecordset("SELECT " & フィールド名 & " FROM " & テーブル名 & " WHERE " & 抽出 & " LIKE 'ZZZZ*' ORDER BY " & 並び替え & ";") While (Not rs.EOF) rs.Edit rs(フィールド名) = "ZZZZ" & Format(i, "0000") rs.Update rs.MoveNext i = i + 1 Wend rs.Close End Sub 両方とも「ODBC--リンクテーブル'XXXX'での更新に失敗しました」 となってしまいます。 どうすれば更新に失敗せずにできるのでしょうか?

  • ループで呼び出しながら、追加クエリでテーブルに追加

    IDをループで呼び出しながら、追加クエリでテーブルに追加したいのですが、 値が入りません。 エラーなく動くのですが、テーブルに値が入っていないのです。 何がたりないのでしょうか? ――――――――――――― Public Sub CYUSYUTU_SEIKYUID2() Dim CYUSYUTU_SEIKYUID As String Dim recCount As Long recCount = DCount("*", "作業用請求先ID") Dim ID As String Dim DB As DAO.Database Dim RS As DAO.Recordset Dim i As Integer Dim strSQL As String Set DB = CurrentDb Set RS = DB.OpenRecordset("作業用請求先ID") RS.MoveFirst Do Until RS.EOF RS.Edit For i = 1 To recCount CYUSYUTU_SEIKYUID = RS.Fields("請求先ID(13)").Value DoCmd.RunSQL _ "INSERT INTO [作業用_▲入金DB] SELECT * FROM ▲入金 WHERE ▲入金.請求先ID='& CYUSYUTU_SEIKYUID &';" Next i RS.Update RS.MoveNext Loop RS.Close: Set RS = Nothing DB.Close: Set DB = Nothing End Sub

  • Accessで、DAOでAddnew

    参照はDAOで、Addnewでデータの追加をしたいのですが、記述が悪いのか、上手くできません。 どなたか、教えて下さい! テーブル:スケジュールソース フィールド:日付 Private Cur_Db As DAO.Connection Private rs As DAO.Recordset Private sql As String Dim str_date As String str_date = Me!日付 Set Cur_Db = CurrentDb rs.Open "スケジュールソース", Cur_Db, dOpenKeyset, adLockOptimistic rs.AddNew rs("日付").Value = str_date rs.Update

  • DAO エクセルvbaからアクセスのレコードの件数

    DAOで、エクセルvbaからアクセスのレコードの件数を取得したいのですが Dim ac As Object Dim db As DAO.Database Dim rs As DAO.Recordset Set ac = CreateObject("Access.Application") Set db = ac.DBEngine.OpenDatabase("D:\あああ.accdb", False, True) Set rs = db.OpenRecordset("SELECT * FROM Tマスタ WHERE masterkey like '*四*';") i = rs.RecordCount Debug.Print rs("masterkey") rs.Close: Set rs = Nothing db.Close: Set db = Nothing ac.Quit: Set ac = Nothing をすると、抽出するレコードが1000件でも、必ず1が返ります。 masterkeyフィールドは文字列型です。 なぜ実際はたくさんのレコードがあるのに、1が返るのでしょうか?

専門家に質問してみよう