データベースの番号を1つずつ加算していく方法

このQ&Aのポイント
  • データベースにデータを入力するたびに、連続した数字の「入力No.」を振りたいと考えています。現在の問題点は、ボタンを押すと入力番号が正しくない、ブックを閉じると番号が保存されない、再度立ち上げても番号が継続されないことです。
  • 以下のコードは、ユーザーフォームの初期化、データベースへの転記、番号の加算、ユーザーフォームの終了の機能が含まれています。
  • 使用機種はWindows VistaでExcel 2007を使用しており、VBA初心者です。
回答を見る
  • ベストアンサー

データベースの番号を1つずつ加算していくには?

●質問の主旨 データベースにデータを入力していくたびに そのデータに「入力No.」1を振り、以後データが増えるたびに 番号を1つずつ増やしていきたいと考えています。 A2→1 A3→2 A4→3 A5→4 という具合に、途中でブックを保存して再度立ち上げても 常に連続した数字を入力したいと思っています。 以下のコードをどのように書き改めばよいでしょうか? ご教示願います。 ●現在の問題点 1.「データベース入力」のボタンを押すと A2セルに「入力No.」2が入力されてしまう 2.ブックを閉じない限り、入力した番号は 2のままで転記されてしまう。 3.ブックを保存して閉じた後、再度立ち上げ「入力No.」を 入力しようとすると今度は4が入力される。 4.その後はブックを保存して閉じた後、再度立ち上げても 4が入力され続ける。 ●コード Option Explicit 'ユーザーフォームの初期化 Private Sub UserForm_Initialize() TextBox3.Value = Worksheets(1).Range("A2").Value + 1 txtdate = Date Call No End Sub 'フォームからデータベースへの転記 Private Sub CommandButton3_Click() Dim Rowpos As Long Dim ColPos As Long Rowpos = Worksheets(1).Range("a10000").End(xlUp).Row ColPos = 1 Rowpos = Rowpos + 1 With Worksheets(1) .Cells(Rowpos, ColPos) = TextBox3.Value .Cells(Rowpos, ColPos + 1) = txtdate.Value End With End Sub 'Noの加算 Private Sub No() Dim i As Long For i = 1 To 1 Step 1 TextBox3.Value = TextBox3.Value + 1 Next End Sub 'ユーザーフォームの終了 Private Sub CommandButton5_Click() Unload UserForm1 End End Sub 以上よろしくお願い申し上げます。使用機種はWindowsVistaで、 Excel2007です。私はVBA初心者です。

質問者が選んだベストアンサー

  • ベストアンサー
  • end-u
  • ベストアンサー率79% (496/625)
回答No.1

>Private Sub CommandButton3_Click() >: >With Worksheets(1) > .Cells(Rowpos, ColPos) = TextBox3.Value > .Cells(Rowpos, ColPos + 1) = txtdate.Value >End With .Cells(Rowpos, ColPos) = TextBox3.Value ここが「入力No.」をセルにセットする箇所。 TextBox3.Valueの値はというと、 >Private Sub UserForm_Initialize() > TextBox3.Value = Worksheets(1).Range("A2").Value + 1 > txtdate = Date > Call No >End Sub ここでA2セル+1をセットして、Call No でさらに+1。 A2セルが 2 だったら 2+1+1 で 4。 UserForm_Initializeイベントで一定のセル値(A2)しか見に行ってないから そりゃ、固定になりますよね。 UserForm_Initializeイベントで一定のセル値(A2)ではなく 最終行の値を見に行くようにすれば良いですよね。 あと、Private Sub No()の中身も見直して下さい。 何か意図があってそういう書き方してますか? 「入力No.」を増分させるには何処かのタイミングで TextBox3.Value = TextBox3.Value + 1 すれば良いです。 またはTextBox3に表示させる必要がなければ 新規データをセルにセットするタイミングで直上行+1でもいいわけです。 それとか .Row-1とか。

dradra33
質問者

お礼

end-u様 先ほどに引き続き連続でアドバイスをしていただき、 ありがとうございます。 end-u様のアドバイスにもとづき 下記のようにコードを書き改めたところ、データベースに 連続した番号を振ることができるようになりました。 'ユーザーフォームの初期化 (3行目) TextBox3.Value = Worksheets(1).Range("a10000").End(xlUp).Row 'Noの加算 (DimやForステートメントは削除。下記のコードのみ) TextBox3.Value = TextBox3.Value + 1 >あと、Private Sub No()の中身も見直して下さい。 >何か意図があってそういう書き方してますか? 特に意図はありません。 手持ちの初級者用のテキストを読んでたら、頻出していたので 何となく自分の判断で使ってみました。 2つ続けてのご回答ありがとうございました。

関連するQ&A

  • ユーザーフォームをWorkSheet(1)に固定

    ●質問の主旨 WorkSheet(1)(「柴田8月分」)にユーザーフォームを固定的に 表示させつつ、WorkSheet(1)以降のWorkSheet(2)、 WorkSheet(3)、WorkSheet(4)の表を参照しながら ComboBox1、ComboBox2、ComboBox3にリストを 選択して、データベースに入力したいと考えています。 以下のコードをどのように書き換えれば良いでしょうか? ご教示のほどよろしくお願い申し上げます。 ●質問の補足 現在のコードでは、ComboBox1、ComboBox2、ComboBox3を それぞれ選択しているとユーザーフォームがそれぞれ WorkSheet(2)、WorkSheet(1)(顧客リスト)、WorkSheet(3)(社員名)、 WorkSheet(4)(大分類)にとんでしまいます。 転記入力が終了すると、また手作業でWorkSheet(1)に戻らなければなりません。 その手作業を回避したいと考えています。 なお添付画像はComboBox1の選択前なのでWorkSheet(1) に留まってくれています。 ●コード Option Explicit 'ユーザーフォームの初期化 Private Sub UserForm_Initialize() Dim r As Range Dim n As Range Dim d As Range With Worksheets(2) Set r = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox1 .ColumnCount = 2 .ColumnWidths = ";0" .List = r.Value End With With Worksheets(3) Set n = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox2 .ColumnCount = 2 .ColumnWidths = ";0" .List = n.Value End With With Worksheets(4) Set d = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox3 .ColumnCount = 2 .ColumnWidths = ";0" .List = d.Value End With Set r = Nothing Set n = Nothing Set d = Nothing TextBox3.Value = Worksheets(1).Range("A2").Value + 1 txtdate = Date OptionButton1.Value = True End Sub 'ComboBox1をクリックしたときの処理 Private Sub ComboBox1_Click() Worksheets(2).Select With Me.ComboBox1 Me.Label19.Caption = .List(.ListIndex, 1) Worksheets(2).Select Replace:=False End With End Sub 'ComboBox2をクリックしたときの処理 Private Sub ComboBox2_Click() Worksheets(3).Select With Me.ComboBox2 Me.Label20.Caption = .List(.ListIndex, 1) Worksheets(3).Select Replace:=False End With End Sub 'フォームからデータベースへの転記 Private Sub CommandButton3_Click() Dim Rowpos As Long Dim ColPos As Long Rowpos = Worksheets("柴田8月分").Range("a10000").End(xlUp).Row ColPos = 1 Rowpos = Rowpos + 1 With Worksheets("柴田8月分") .Cells(Rowpos, ColPos) = TextBox3.Value .Cells(Rowpos, ColPos + 1) = txtdate.Value .Cells(Rowpos, ColPos + 2) = Label19.Caption .Cells(Rowpos, ColPos + 3) = ComboBox1.Text .Cells(Rowpos, ColPos + 4) = ComboBox2.Text .Cells(Rowpos, ColPos + 5) = Label20.Caption .Cells(Rowpos, ColPos + 6) = ComboBox3.Text End With 'Noの加算 Dim i As Long For i = 1 To 1 Step 1 TextBox3.Value = TextBox3.Value + 1 Next Call Clearcmb End Sub 'データベース入力後にコンボボックスを空欄にする Private Sub Clearcmb() ComboBox1.Text = "" ComboBox2.Text = "" ComboBox3.Text = "" End Sub 'ユーザーフォームの終了 Private Sub CommandButton5_Click() Unload UserForm1 End End Sub 以上よろしくお願い申し上げます。使用機種はWindowsVistaで、 Excel2007です。私はVBA初心者です。

  • コンボボックスの値で参照するワークシートを変えたい

    ●質問の主旨 ComboBox3で選択した文字列によって、参照するワークシートを 変え、そのワークシートからComboBox4に代入するには、以下の コードをどのように書き換えればよいでしょうか? ご教示願います。 ●質問の補足 添付画像でComboBox3に「営業」、「技術」、「総務」まで 入力することによってそれぞれ3つのワークシートを参照 させたいと考えています。 ・「営業」→中分類(営業)シート ・「技術」→中分類(技術)シート ・「総務」→中分類(総務)シート そして各シートにはそれぞれ異なった仕事内容の表が 既に作成されています。もしComboBox3で「営業」を 選択したなら、ComboBox4で中分類(営業)シートに 記載されている仕事内容を選択できるようにしたいと 考えています。 そのためSelect Caseステートメントを使って ComboBox3の内容によってComboBox4の内容を変える コードを作成したつもりです。 ●現在の問題点 1.下記のコードを実行しようとすると、 「実行時エラー91 オブジェクト変数またはWithブロック変数が設定されていません」 というエラーが返されます。 2.デバックするとユーザーフォームではなく、 標準モジュールの2行目 UserForm1.Show が黄色くなります。 ●コード (標準モジュール) Sub 日報記入ダイアログ() UserForm1.Show End Sub (ユーザーフォーム) Option Explicit Private Sub ComboBox4_Change() End Sub 'ユーザーフォームの初期化 Private Sub UserForm_Initialize() Dim r As Range Dim n As Range Dim d As Range Dim t As Range With Worksheets(2) Set r = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox1 .ColumnCount = 2 .ColumnWidths = ";0" .List = r.Value End With With Worksheets(3) Set n = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox2 .ColumnCount = 2 .ColumnWidths = ";0" .List = n.Value End With With Worksheets(4) Set d = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox3 .ColumnCount = 2 .ColumnWidths = ";0" .List = d.Value End With '中分類のComboBox4は「大分類」の選択内容によって参照するワークシートが変わる Select Case t Case Is = ComboBox3("営業") With Worksheets(5) Set t = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox4 .ColumnCount = 2 .ColumnWidths = ";0" .List = t.Value End With Case Is = ComboBox3("技術") With Worksheets(6) Set t = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox4 .ColumnCount = 2 .ColumnWidths = ";0" .List = t.Value End With Case Is = ComboBox3("総務") With Worksheets(7) Set t = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox4 .ColumnCount = 2 .ColumnWidths = ";0" .List = t.Value End With End Select 'メモリの解放 Set r = Nothing Set n = Nothing Set d = Nothing Set t = Nothing 'その他の初期値 TextBox3.Value = Worksheets(1).Range("a10000").End(xlUp).Row txtdate = Date End Sub 'ComboBox1をクリックしたときの処理 Private Sub ComboBox1_Click() With Me.ComboBox1 Me.Label19.Caption = .List(.ListIndex, 1) End With End Sub 'ComboBox2をクリックしたときの処理 Private Sub ComboBox2_Click() With Me.ComboBox2 Me.Label20.Caption = .List(.ListIndex, 1) End With End Sub 'ComboBox2をクリックしたときの処理(中分類の仕事によってスターマークが変わる) 'フォームからデータベースへの転記 Private Sub CommandButton3_Click() Dim Rowpos As Long Dim ColPos As Long Rowpos = Worksheets(1).Range("a10000").End(xlUp).Row ColPos = 1 Rowpos = Rowpos + 1 With Worksheets(1) .Cells(Rowpos, ColPos) = TextBox3.Value .Cells(Rowpos, ColPos + 1) = txtdate.Value .Cells(Rowpos, ColPos + 2) = Label19.Caption .Cells(Rowpos, ColPos + 3) = ComboBox1.Text .Cells(Rowpos, ColPos + 4) = ComboBox2.Text .Cells(Rowpos, ColPos + 5) = Label20.Caption .Cells(Rowpos, ColPos + 6) = ComboBox3.Text End With 'Noの加算 TextBox3.Value = TextBox3.Value + 1 Call Clearcmb End Sub 'データベース入力後にコンボボックスを空欄にする Private Sub Clearcmb() ComboBox1.Text = "" ComboBox2.Text = "" ComboBox3.Text = "" End Sub 'ユーザーフォームの終了 Private Sub CommandButton5_Click() Unload UserForm1 End End Sub 以上よろしくお願い申し上げます。使用機種はWindowsVistaで、 Excel2007です。私はVBA初心者です。添付の画像でのユーザーフォームは プリントスクリーンでWorksheet(1)に貼り付けています。

  • ユーザーフォームの内容が一部だけ残らない。

    VBAを始めてまだ1週間ほどなのでどの部分を変えればよいのかわかりません。 どなたかわかる方が居れば回答をお願いします。 問題:下記の構文でTextBox2の内容だけが残らない。 UserFoem1で記入場所が7つあり、ボタン1(入力)を押すと 7つの内容がSheet(履歴表)に転記されます。 ボタン2(終了)を押すとUserFormが消えます。 そして転記された後、内容をそのまま7つのTextBoxに残したいと思っています。 TextBox1(txtDate)日付を自動で表示して、 TextBox3~7までは転記後も内容は残るのですが、 TextBox2の内容だけが残らないのです。 下記の構文はネット上でいろんな方のものをコピペして製作したので、 訳の分からない文字がたくさんあり理解をしていない部分はあります。 ですので回答をいただけるならTextBox2の問題解決と 下記の内容をもっとスマートな形に変えて 不要な部分を削除して頂けたらと思っています。 宜しくお願い致します。 Sub ユーザーフォームで履歴表へ入力する() End Sub Private Sub CommandButton1_Click() Dim n As Long With Worksheets("履歴表") n = .Range("B" & Rows.Count).End(xlUp).Row  'Bの一番下を検索する Cells(n + 1, 2).Value = txtDate.Value    'テキストボックス2に自動で日付を入れてB列へ Cells(n + 1, 3).Value = TextBox2.Value 'C列へ代入 Cells(n + 1, 4).Value = TextBox3.Value 'D列へ代入 Cells(n + 1, 5).Value = TextBox4.Value 'E列へ代入 Cells(n + 1, 6).Value = TextBox5.Value 'F列へ代入 Cells(n + 1, 7).Value = TextBox6.Value 'G列へ代入 Cells(n + 1, 8).Value = TextBox7.Value 'H列へ代入 Range(Cells(n + 1, 2), Cells(n + 1, 2)).Offset(, -1).Value = Range(Cells(n + 1, 2), Cells(n + 1, 2)).Row - 4   'A列に番号を順番に入れる End With TextBox2.Value = "" TextBox2.SetFocus End Sub Private Sub TextBox2_Change() '商品名 End Sub Private Sub TextBox3_Change() '型式・形式 End Sub Private Sub TextBox4_Change() '数量 End Sub Private Sub TextBox5_Change() '客先 End Sub Private Sub TextBox6_Change() '担当 End Sub Private Sub TextBox7_Change() '備考 End Sub Private Sub txtDate_Change() End Sub Private Sub UserForm_Click() End Sub Private Sub UserForm_Initialize() UserForm1.txtDate.Value = Date End Sub Private Sub CommandButton2_Click() Me.Hide End Sub

  • ユーザーフォームからワークシートへの転記について

    ●質問の主旨 エクセルVBAの初心者です。 添付画像のユーザーフォームからデータベースへの転記の コードを記述しましたが、実行しようとすると15行目の「CelData」のところが 選択され、コンパイルエラー(変数の定義がされていません) が返されます。 1.「CelData」のコンパイルエラーはどのように修正すれば   よいでしょうか? 2.またこのコンパイルエラーを修正すれば、ユーザーフォームから   ワークシートへの転記ができるでしょうか? ●質問の補足 1.ユーザーフォームにある「入力No.」と 「入力日」(赤色で囲った部分)をそれぞれ A2セル、B2セル(青色で囲った部分)に転記しようと 考えています。 2.添付画像のワークシートには手入力で「柴田8月分」 というシート名が予めつけられています。 3.ユーザーフォームやワークシートには 他に入力、転記する個所がありますが質問を 簡単にするため省略しています。 4.この質問に関するオブジェクト名は以下の 通りです。 ・「入力No.」=TextBox3 ・「入力日」=txtdate ・「データベース入力」=CommandButton3 エクセルVBAにお詳しい方ご教示願います。 使用機種はWindows Vista Excel2007です。 なお、コードは以下の通りです。 1 Option Explicit 2 'ユーザーフォームの初期化 3 Private Sub UserForm_Initialize() 4 TextBox3.Value = 1 5 txtdate = Date 6 End Sub 7 'ユーザーフォームからデータベースへの転記 8 Private Sub データベース入力_Click() 9 Dim RowPos As Integer 10 Dim ColPos As Integer 11 RowPos = 2 12 ColPos = 1 13 Do 14 RowPos = RowPos + 1 15 CelData = Worksheets("柴田8月分").Cells(RowPos, _ 16 ColPos) 17 Loop While CelData <> "" 18 With Worksheets("柴田8月分") 19 .Cells(RowPos, ColPos) = TextBox3.Value 20 .Cells(RowPos, ColPos + 1) = txtdate.Value 21 End With 22 End Sub

  • コンボボックスとスピンボタン

    いつも勉強させていただいています。 ユーザーフォームにコンボボックスとスピンボタンを組み 日付の取得をしました。欲しいのは年と月だけです。(2001/11) どうしても日付を外すことが出来ません。宜しくお願いします。 Private Sub spnDate_SpinDown() Dim dtDate As Date dtDate = UserForm1.txtDate.Value UserForm1.txtDate.Value = DateAdd("m", -1, dtDate) End Sub Private Sub spnDate_SpinUp() Dim dtDate As Date dtDate = UserForm1.txtDate.Value UserForm1.txtDate.Value = DateAdd("m", 1, dtDate) End Sub Private Sub UserForm_Initialize() UserForm1.txtDate.Value = Date End Sub

  • Excel オーダーフォームのテキストボックス入力について

    オーダーフォームを作成し、テキストボックスを2つ以上作成し、コマンドボタンを1つ作りました。 同じ行ですべてを入力できるようにしたいのですが、どうしたらよいでしょうか? テキストボックス1の値を入力するためのコマンドは、最下位の行を探してそこに入力するようなコマンドを作っているはずです…その横の列にテキストボックス2の値を入力し、その横の列にテキストボックス3の値を入力し…というようにしていきたいのです。 Private Sub CommandButton1_Click() Dim lRow As Long With Worksheets("sheet1") lRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & lRow + 1).Value = TextBox1.Value End With TextBox1.Value = "" TextBox1.SetFocus End Sub

  • excel ユーザーフォームでシートごとに転記2

    先日ユーザーフォームへの転記について質問させていただきました。 ご回答いただき、ありがとうございました。 今度はオプションボタンで選択したときに、シートごとに転記する方法を 教えていただけますでしょうか。 ユーザフォーム上で、オプションボタンを選択。 OptionButton1・・・シート1へ転記 OptionButton2・・・シート2へ転記 これをOKボタンを押したときに転記するようにしたいと思っています。 Private Sub OK_Click() Dim CLrow As Long Dim KYrow As Long CLrow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row KYrow = Worksheets("Sheet2").Range("A65536").End(xlUp).Row If OptionButton1.Value = True Then Worksheets("Sheet1").Range("A" & CLrow).Value = .TextBox1.Value ElseIf OptionButton2.Value = True Then Worksheets("Sheet2").Range("A" & KYrow).Value = .TextBox1.Value End With End Sub ここまでやってみたのですが「参照が不正または不完全です」 と出てしまいます。 どなたかご教示願います。 よろしくお願いします。

  • マクロ セル指定について

    Sheet(”体温”)のA3に フォームのTextBox1の内容をボタンを押したら 挿入させたいです。! 下の記述では上手くいきません 教えて下さい! Private Sub CommandButton1_Click() With Worksheets("体温") .Range(A3).Value = TextBox1.Value End With End Sub お願いします!

  • マクロ

    宜しくお願いいたします セルを選択するマクロですが、何処か間違っているので 実行すると、K25のみ選択されてしまいます 一行おきに選択したいのですが 以下のマクロです Sub セルの選択2() Dim ColPos As Integer Dim RowPos As Integer For ColPos = 1 To 11 Step 2 For RowPos = 5 To 25 Step 2 Cells(RowPos, ColPos).Select Next Next End Sub

  • excel2000 vba スピンボタン

    いつもお世話になっています。 下記内容の変更をしたいのですが、自分ではうまくいかず、お力をお貸しください。 よろしくお願いします。 一枚のデータシートと一枚の入力用フォームがあります。 入力フォームのスピンボタンのNOをキーにして、データシートのレコードを一件ずつ切り替えて、表示させるようにしています。 さてデータシートのオートフィルターでフィルターをかけた時に、それにあわせて、スピンボタンのNOを飛ばすようにしたいのですが、どのように修正していいか、わかりません。 現状ですと、下記プロシージャですが、いまのままだと、スピンボタンの値が一つずつしかかわりません。 'スピンボタンの値が変わったらテキストボックスに反映 Private Sub SpinButton1_Change() TextBox1.Value = SpinButton1.Value Call hyouji End Sub Private Sub hyouji() 'データを検索して表示する Dim fRange As Range Dim fRow As Long Set fRange = Sheets("data").Columns(3).Find(what:=TextBox1.Value, _ LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows) If (fRange Is Nothing) Then ' MsgBox "Noがみつかりません", vbExclamation Exit Sub End If fRow = fRange.Row '検索されたNoの行位置を求める With Worksheets("data") TextBox2.Value = .Cells(fRow, 4).Value TextBox3.Value = .Cells(fRow, 5).Value TextBox4.Value = .Cells(fRow, 6).Value TextBox5.Value = .Cells(fRow, 7).Value TextBox6.Value = .Cells(fRow, 8).Value End With SpinButton1.SetFocus End Sub ※現物ファイルを下記に投稿(No5643)させていただきました。見ていただけると幸いです。 http://www.kent-web.com/pubc/book/test/uploader/uploader.cgi

専門家に質問してみよう