• ベストアンサー

ACCESS2000でコードごとの連番を振るには

tsukasa-12rの回答

回答No.1

>連番を付与したあとで単価を削除しても連番が消えません。 というのは、一度連番を付与したあとで、単価を消して、もう一度実行したら、単価を消したレコードの番号が残ったまま、ということですよね? If rst.Fields("単価") > 0 Then   fldNo = count   count = count + 1 Else   fldNo = Null End If rst.Update という感じですね。

ohdorry
質問者

補足

tsukasa-12rさんありがとうございました。 >単価を消したレコードの番号が残ったまま・・・ そういう状態です。 教えていただいたコードに差し替えて (前略) rst.Update Loop End If dbs.Close ・ ・ ・ としましたが「オーバーフローしました」と表示されます。 「オーバーフロー」とは変数の型の違い? あるいは私の貼り付け間違いでしょうか? お手数ですがよろしくお願いします。

関連するQ&A

  • access2000設定について

    access2000で下記のような設定をしています。 フォーム画面より、表示ボタンをクリックすると プレビュー状態でそのままで、画面に表示されません。どこが悪いのでしょうか・ Private Sub cmd表示_Click() DoCmd.Maximize If gOnErrorCtl Then On Error GoTo Err_cmd表示_Click lblStatus.Caption = "総勘定元帳をプレビュー表示します" Call PrintSokanjo If RtnCd Then lblStatus.Caption = "プレビュー中 . . ." DoCmd.OpenReport "R_総勘定元帳出力用変更", acViewPreview lblStatus.Caption = "総勘定元帳プレビュー終了" Else MsgBox "印刷は中止されました", vbOKOnly, AppName End If Exit_cmd表示_Click: Exit Sub Err_cmd表示_Click: Resume Exit_cmd表示_Click End Sub

  • accessからexcelへ出力時。。。

    3つのクエリを一つのエクセルシートへ出力しようとしているのですが、 3つ目が張り付きません。なんでなんでしょうか?どなたか教えてください。 Dim dbs As Database Dim rst1 As Recordset Dim rst2 As Recordset Dim rst3 As Recordset Dim intRow As Integer Dim intCell As Integer Dim xlsx As Object Set dbs = CurrentDb Set rst1 = dbs.OpenRecordset("クエリA") Set rst2 = dbs.OpenRecordset("クエリB") Set rst3 = dbs.OpenRecordset("クエリC") Set xlsx = CreateObject("Excel.Application") 'Excelオブジェクトを生成 With xlsx .ScreenUpdating = False '画面の再描画を抑止 .Workbooks.Add '新しいブックを追加 '---"クエリA"---------------------------------------------------- intRow = 1 For intCell = 1 To rst1.Fields.Count .Cells(intRow, intCell).Value = rst1.Fields(intCell - 1).Name .Cells(intRow, intCell).Interior.ColorIndex = 15 Next intCell '各レコード出力 intRow = 2 Do Until rst1.EOF For intCell = 1 To rst1.Fields.Count .Cells(intRow, intCell).Value = rst1.Fields(intCell - 1) Next intCell intRow = intRow + 1 rst1.MoveNext Loop '集計Sum For intCell = 4 To rst1.Fields.Count .Cells(intRow + 1, intCell) = "=SUM(" & Cells(2, intCell).Address & ":" & Cells(intRow, intCell).Address & ")" Next intCell ・ ・2目のクエリはOK ・ ・ ’以下3つ目のクエリ Dim intRow3 As Integer Dim intCell3 As Integer intRow3 = intRow + 5 intCell3 = 5 For intCell3 = 5 To rst3.Fields.Count .Cells(intRow3, intCell3).Value = rst3.Fields(intCell3 - 1).Name .Cells(intRow3, intCell3).Interior.ColorIndex = 15 Next intCell3 '各レコード出力 intRow3 = intRow + 6 Do Until rst3.EOF For intCell3 = 5 To rst3.Fields.Count .Cells(intRow3, intCell3).Value = rst3.Fields(intCell3 - 1) Next intCell3 intRow3 = intRow3 + 1 rst3.MoveNext Loop '---- Dim rst3RC As Integer rst3RC = intRow + 5 + rst3.RecordCount '863 '集計Sum For intCell3 = 6 To rst3.Fields.Count - 1 .Cells(rst3RC, intCell3) = "=SUM(" & Cells(rst3RC - rst3.RecordCount, intCell3).Address & ":" & Cells(rst3RC - 1, intCell3).Address & ")" Next intCell3

  • ACCESSを活用して商品変動を捉えたい(5再再)

    http://okwave.jp/qa/q8782706.html 上記について標準モジュールも作成して、先のクエリーを実行しましたが、 その際に !コンパイル エラー: ユーザー定義型は定義されていません。 と出ます。 5行目の rst As ADODB.Recordset 箇所が反転されています。 一回でできるのは魅力なのですが、本当に実装できるのでしょうか。 (クエリーはたしかに保存できました) Public Function DBLookup(ByVal strQuerySQL As String, _              Optional ByVal ReturnValue = Null) As Variant On Error GoTo Err_DBLookup   Dim DataValue   Dim rst     As ADODB.Recordset   Set rst = New ADODB.Recordset   With rst     .Open strQuerySQL, _        CurrentProject.Connection, _        adOpenStatic, _        adLockReadOnly     If Not .BOF Then       .MoveFirst       DataValue = .Fields(0)     End If   End With Exit_DBLookup: On Error Resume Next   rst.Close   Set rst = Nothing   DBLookup = IIf(Len(DataValue & ""), DataValue, ReturnValue)   Exit Function Err_DBLookup:   MsgBox "SELECT 文の実行時にエラーが発生しました。(DBLookup)" & Chr$(13) & Chr$(13) & _       "・Err.Description=" & Err.Description & Chr$(13) & _       "・SQL Text=" & strQuerySQL, _       vbExclamation, " 関数エラーメッセージ"   Resume Exit_DBLookup End Function Public Function DBLookup(ByVal strQuerySQL As String, _              Optional ByVal ReturnValue = Null) As Variant On Error GoTo Err_DBLookup   Dim DataValue   Dim rst     As ADODB.Recordset   Set rst = New ADODB.Recordset   With rst     .Open strQuerySQL, _        CurrentProject.Connection, _        adOpenStatic, _        adLockReadOnly     If Not .BOF Then       .MoveFirst       DataValue = .Fields(0)     End If   End With Exit_DBLookup: On Error Resume Next   rst.Close   Set rst = Nothing   DBLookup = IIf(Len(DataValue & ""), DataValue, ReturnValue)   Exit Function Err_DBLookup:   MsgBox "SELECT 文の実行時にエラーが発生しました。(DBLookup)" & Chr$(13) & Chr$(13) & _       "・Err.Description=" & Err.Description & Chr$(13) & _       "・SQL Text=" & strQuerySQL, _       vbExclamation, " 関数エラーメッセージ"   Resume Exit_DBLookup End Function

  • 100問を超えたら終了ですのメッセージをだしたい(あくせす)

    Private Sub cmd次_Click() On Error GoTo Err_cmd次_Click DoCmd.GoToRecord acForm, "F_さあやってみよう", acNext If (Forms!F_さあやってみよう!txt番号 = 100) 'これだと100問になったときにメッセージがでてしまいます。100問を終了してボタンをクリックしたら 終了のメッセージを表示したいのですが、 101という番号はありません。 Then Beep MsgBox "終了です(*^。^*)", vbInformation, "終了" End If Exit_cmd次_Click: Exit Sub Err_cmd次_Click: MsgBox Err.Description Resume Exit_cmd次_Click End Sub よろしくお願いしますm(__)m

  • access vba 構文の解読

    access vba 構文の解読 はじめまして先ほどaccess2003について質問させていただいたものです。以下の構文が先ほどの続きです。こちらも皆様のお力で構文を解読していただけないでしょうか。 すみません解読とは、構文の一行一行が何を示しているのか教えていただけると助かります。 よろしくお願いいたします。 ' Exit the application. Case conCmdExitApplication CloseCurrentDatabase ' Run a macro. Case conCmdRunMacro DoCmd.RunMacro rs![Argument] ' Run code. Case conCmdRunCode Application.Run rs![Argument] ' Open a Data Access Page Case conCmdOpenPage DoCmd.OpenDataAccessPage rs![Argument] ' Any other command is unrecognized. Case Else MsgBox "不明なオプションです。" End Select ' Close the recordset and the database. rs.Close HandleButtonClick_Exit: On Error Resume Next Set rs = Nothing Set con = Nothing Exit Function HandleButtonClick_Err: ' If the action was cancelled by the user for ' some reason, don't display an error message. ' Instead, resume on the next line. If (Err = conErrDoCmdCancelled) Then Resume Next Else MsgBox "コマンド実行中のエラーです。", vbCritical Resume HandleButtonClick_Exit End If End Function Private Sub メニュー終了_Click() On Error GoTo Err_メニュー終了_Click DoCmd.Close Exit_メニュー終了_Click: Exit Sub Err_メニュー終了_Click: MsgBox Err.Description Resume Exit_メニュー終了_Click End Sub Private Sub 終了_Click() On Error GoTo Err_終了_Click DoCmd.Quit Exit_終了_Click: Exit Sub Err_終了_Click: MsgBox Err.Description Resume Exit_終了_Click End Sub

  • アクセスのフォームからレコード入力空欄回避のVBA

    アクセス初心者です。 帳票式フォームからテーブルへのレコード入力において、次のレコード入力ボタンで空欄を防止するためのVBAを作っていますが、うまく行きません。空欄があれば警告は出ますがそのままテーブルへ記録されてしまいます。 テーブルに記録されずに空欄が入力できるようにするにはどうすればよいのでしょうか? また、次を入力するときにフォームの製品名の内容だけ消えずに残したいのですが、そのプログラムについても教えていただきたいです。 なかなかうまく行かずに大変困っています。 どなたかVBAの達人の方、初心者にわかりやすくお教え下さい。 「入力内容を登録して次を入力」ボタンで作ったVBAは次の通りです。 つぎはぎなので、不要なプログラムもあるかもしれません。 Private Sub コマンド9次のレコードに_Click() On Error GoTo Err_コマンド9次のレコードに_Click DoCmd.GoToRecord , , acNext Exit_コマンド9次のレコードに_Click: Exit Sub Dim Rst As DAO.Recordset Set Rst = CurrentDb.OpenRecordset("T_指定材料表", dbOpenTable) With Rst .AddNew .Fields("製品名") = Me!製品名 .Fields("回路記号") = Me!回路記号 .Fields("部品名") = Me!部品名 .Fields("員数") = Me!員数 .Update If IsNull(Me!製品名) Then MsgBox ("製品名が空欄です。") Resume Exit_コマンド9次のレコードに_Click End If If IsNull(Me!回路記号) Then MsgBox ("回路記号が空欄です。") Resume Exit_コマンド9次のレコードに_Click End If If IsNull(Me!部品名) Then MsgBox ("部品名が空欄です。") Resume Exit_コマンド9次のレコードに_Click End If If IsNull(Me!員数) Then MsgBox ("員数が空欄です。") Resume Exit_コマンド9次のレコードに_Click End If End With On Error Resume Next DoCmd.GoToRecord DataForm, "T_指定材料表", acNew Rst.Close Set Rst = Nothing Call ClearControls End Sub

  • Access2007 データ型エラーについて

    お世話になっております。 下記のVBAでコードを数値型からテキスト型に変更したところ、「抽出条件でデータ型が一致しません。」というエラーが出ました。 デバッグをクリックすると、dbs.Execute strSQLの部分が黄色に反転しています。 VBAはあまり詳しくありませんので、エラーが出なくなる方法を教えていただければ助かります。 よろしくお願いいたします。 Private Sub 在庫差引_Click() Dim dbs As Database Dim rst As Recordset Dim strSQL As String Set dbs = CurrentDb Set rst = Me!サブフォーム.Form.RecordsetClone With rst .MoveFirst Do Until .EOF strSQL = "UPDATE マスター " & _ "SET 在庫数 = NZ(在庫数) - " & Nz(!数量, 0) & " " & _ "WHERE コード = " & !コード dbs.Execute strSQL .MoveNext Loop .Close End With End Sub

  • アクセス2000(ADO)のレコード更新について

    1件しかレコードがない[リスト連番T]テーブルのレコードを読みだして、(フィールド)リストNOをプラス1して更新したいです。 DOAが混ざっているのか、下記のようにエラーがでます。プラス1して更新する正しいプログラムを教えて下さい。 Private Sub リスト_Click() Dim DBS As Databasu Dim CNC As New ADODB.Connection Dim RST As New ADODB.Recordset Dim LISTNO As Intejer Set CNC = CurrentProject.Connection RST.Open "リスト連番T", CNC, adOpenKeyset,adLockOptimistic, adCmdTableDirect LISTNO = RST!リストNO RST.Close Set RST = Nothing CNC.Close Set CNC = Nothing Set DBS = CurrentDb Set RST = DBS.OpenRecordset("リスト連番T") With RST -----.Edit で コンパイルエラー-----   メソッドまたはデータメンバーがみつかりません .Edit !リストNO = LISTNO + 1 .Update .Close

  • Access2007 コンパイルエラーについて

    お世話になっております。 Access2003で問題なく使っていたプログラムを2007用accdbに変換して2007で動かしたところ、コンパイルエラーが出るようになりました。 エラー表示 コンパイルエラー:メソッドまたはデータ メンバが見つかりません。 コードは以下のとおりで(抜粋)、.Edit部分が反転します。 簡単なVBAはわかりますが、今回のエラーは何が原因かわかりませんので、ご教授いただければ幸いです。 よろしくお願いいたします。 Private Sub 元に戻す1_Click() Dim dbs As Database Dim rst1 As Recordset Dim rst2 As Recordset Dim strSQL As String Dim lngTmpVol As Long Dim lngSubVol As Long DoCmd.RunCommand acCmdSaveRecord Set dbs = CurrentDb '売上構成テーブルから画面上のb伝票コードのレコードセットを開く strSQL = "SELECT bbコード, 数量 FROM 売上構成 " & _ "WHERE b伝票コード = " & Me!b伝票コード & _ " ORDER BY 売上構成コード DESC" Set rst1 = dbs.OpenRecordset(strSQL) '売上構成の読み込みループ Do Until rst1.EOF 'カレントレコードの数量を変数に保存 lngTmpVol = rst1!数量 'カレントレコードのbbコードと画面上の社員コードで出庫履歴のレコードセットを開く strSQL = "SELECT 出庫数量, 確定数量, 返却数量 FROM 出庫履歴 " & _ "WHERE bbコード = " & rst1!bbコード & " AND 社員コード = " & Me!社員コード & _ " ORDER BY 出庫日 DESC, 出庫コード DESC" Set rst2 = dbs.OpenRecordset(strSQL) With rst2 If .RecordCount > 0 Then '出庫履歴の読み込みループ Do Until .EOF .Edit If Nz(!確定数量) >= lngTmpVol Then '数量すべてを確定数量から減算できるとき '減算後の数量を取得 lngSubVol = Nz(!確定数量) - lngTmpVol !確定数量 = IIf(lngSubVol <> 0, lngSubVol, Null) lngTmpVol = 0 Else '数量すべては確定数量から減算できないとき lngTmpVol = lngTmpVol - Nz(!確定数量) !確定数量 = Null End If .Update 'すべてを割り当てたらループを抜ける If lngTmpVol <= 0 Then Exit Do .MoveNext Loop End If .Close End With rst1.MoveNext Loop rst1.Close End Sub

  • Access VBAで行ラベルが定義されていないというエラーが出ます

    VBA初心者です。 下記のソースで行ラベルを定義しているつもりなのですが、 なぜか行ラベルが定義されていませんというコンパイルエラーがでます。 よろしくお願いします。 Private Sub cmd_Click() On Error GoTo Err_cmd_Click <---ここ Dim inp As String Dim cnt As Integer inp = Forms![フォーム1]![日付] 'フォームの非連結テキストボックスと連動 For cnt = 1 To 31 'インポート・フルパス名作成 If (cnt) < 9 Then strImportFileNameM = "M:\PdxLog\KabeKaKinA" & inp & "0" & cnt + 1 & ".csv" DoCmd.TransferText acImportDelim, , "KabeDownLoad", strImportFileNameM, False Else strImportFileNameM = "M:\PdxLog\KabeKaKinA" & inp & cnt + 1 & ".csv" DoCmd.TransferText acImportDelim, , "KabeDownLoad", strImportFileNameM, False End If Next cnt '正常終了 Exit_cmd_Click: End Sub 'エラー処理 Err_cmd_Click: Beep Select Case Err.Number Case Else MsgBox Err.Number & ":" & Err.Description End Select Resume Next End Sub