エクセルでデータを蓄積するVBA

質問

蔵書管理用の一覧表です。
エクセルでデータ入力用のフォームは作ることができたのですがシートに転記するVBAをどのように書けばよいのか分かりません。
データは次々に増えていきます。
A列には番号を入力せずに自動的に番号が増えていくようにしたい。
３番まで入力済みのあとは、自動で「４」と番号が付与されて、下の行に転記されるようにしたい。
VBA初心者です。よろしくお願いします。

A　　　　B　　　　　　C　　　　　　　　　　D
番号　分類　　　　　図書名　　　　　　冊数
１　　　文庫本　　　 日本の歴史　　　３
２　　　週刊誌　　　 新潮　　　　　　　 １
３　　　月刊誌　　　 月刊ゴルフ　　　 １

回答No.3

K Kazz（@JazzCorp）

カンペならイッパイ転がってるよ～、、、

ユーザフォーム入門 - 住所入力フォームを作成する(4) ～ ワークシートへの転記他
(Excel 2000)
http://www.moug.net/tech/exvba/0090037.html

お礼

ありがとうございます。
参考にしながら勉強します。

回答No.2

tom04

こんにちは！

＞エクセルでデータ入力用のフォームは作ることができたのですが

とありますが、どのようなフォームになっているか判りませんので

テキストボックスを3個配置し、
テキストボックス1が「分類」
テキストボックス2が「図書名」
テキストボックス3が「冊数」の数値
をそれぞれ入力し、コマンドボタンでSheetに上から順次表示させるユーザーフォームだとします。

仮に1行目が項目行で2行目以降のA～D列にデータを列記する場合の一例です。
コマンドボタンのコードに

Private Sub CommandButton1_Click()
With Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Value = .Row - 1
.Offset(, 1) = TextBox1
.Offset(, 2) = TextBox2
.Offset(, 3) = TextBox3.Value
End With
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
End Sub

といった具合ではどうでしょうか？

※　コード内の
＞ .Row - 1
の部分で番号調節を行います。
仮に項目行が4列目で5行目からデータを列記する場合は
＞ .Row - 4
となります。

参考になりますかね？m（_ _）m

お礼

わかりやすいアドバイスありがとうございます。
思った通りに出来そうです。

回答No.1

Miss-Meg

作成されたデータ入力用のフォームが、どのような物なのか分かりませんが、
仮に、添付の図のような環境だとします。

ユーザフォームのコードは、以下のように感じになります。

--------------------------------------------------

''------------------------------
'' フォームの初期化
''------------------------------
Private Sub UserForm_Initialize()

'' 分類のセット
cmbGroup.AddItem "文庫本"
cmbGroup.AddItem "週刊誌"
cmbGroup.AddItem "月刊誌"

'' 冊数のセット
txtNumber.Value = 1
txtNumber.Locked = True

End Sub

''------------------------------
'' 冊数スピンボタン[▲]押下時
''------------------------------
Private Sub spnNumber_SpinUp()
txtNumber.Value = txtNumber.Value + 1
End Sub

''------------------------------
'' 冊数スピンボタン[▼]押下時
''------------------------------
Private Sub spnNumber_SpinDown()
If txtNumber.Value > 1 Then
txtNumber.Value = txtNumber.Value - 1
End If
End Sub

''------------------------------
'' 新規登録ボタン押下時
''------------------------------
Private Sub cmdAdd_Click()
Dim ws As Worksheet
Dim ret As Range
Dim iRow As Long

'' 確認メッセージ
If MsgBox("登録しますか？", vbQuestion + vbYesNo) = vbNo Then
Exit Sub
End If

'' 入力チェック
If cmbGroup.Value = "" Then
MsgBox "分類を選択してください"
Exit Sub
End If
If Trim(txtTitle.Value) = "" Then
MsgBox "タイトルを入力してください"
Exit Sub
End If

'' 対象のワークシートをセット
Set ws = ThisWorkbook.Worksheets("蔵書一覧")

'' 重複チェック
Set ret = ws.UsedRange.Find( _
What:=txtTitle.Value, _
After:=ws.Range("C2"), _
LookAt:=xlWhole, _
SearchOrder:=xlByRows)
If Not ret Is Nothing Then
MsgBox "タイトル『" & txtTitle.Value & "』は既に登録されています。"
Exit Sub
End If

'' 新規行の追加
iRow = ws.UsedRange.End(xlDown).row + 1
ws.Cells(iRow, 1).Value = ws.Cells(iRow - 1, 1).Value + 1
ws.Cells(iRow, 2).Value = cmbGroup.Value
ws.Cells(iRow, 3).Value = txtTitle.Value
ws.Cells(iRow, 4).Value = txtNumber.Value

'' 書式のセット
ws.Range(ws.Cells(iRow - 1, 1), ws.Cells(iRow - 1, 4)).Copy
ws.Range(ws.Cells(iRow, 1), ws.Cells(iRow, 4)).PasteSpecial _
Paste:=xlPasteFormats
Application.CutCopyMode = False
ws.Cells(1, 1).Select

End Sub

--------------------------------------------------

上記コードでは、適当に入力チェックや重複チェックを入れてありますが、
これらは仕様によりますので、必要に応じて行ってください。

お礼

丁寧に教えて頂きありがとうございます。
重複チェックなんて・・・感動です。
とても勉強になります。