EXCEL2003 VBA リストボックス

質問

お世話になります。

質問の内容についてですが、
現在VBAの勉強をしながらデータベースを組んでいます。
そこで、次のようなものを作っています。

Sheet1に於いて、

　　　 A　　　　B　　　　　C
1　　追番　　名称　　　個数
2　　　1　　　りんご　　 1個
3　　　2　　　みかん　　2個
4　　　3　　　なし　　　　3個
5　　　4　　　なす　　　　5個

というような表があるとします。

そして、VBAでフォームをつくり、TextBox1（名称入力用）、TextBox2（個数入力用）、ListBox1（すでに入力されているもの及び追加分のリスト用）、CommandButton1（入力された「名称」と「個数」をSheet１の表の一番下に追加）、CommandButton2（フォームを閉じる）という構成にしています。
また、Sheet1上にコマンドボタンを作っており、そのボタンを押すとフォームを呼出すようにしています。

流れとしては、既存の表に追加する場合、コマンドボタンを押してフォームを呼出し、テキストボックスに入力した内容をSheet1の一番下に追加する。また、フォーム上のリストボックスでも現在の表の内容を見る事ができる、というものです。

フォームでのコードは以下のようにしています。
Private Sub CommandButton1_Click()
If TextBox1.Value = "" Then
MsgBox "「名称」は必須項目です。"
End If

If TextBox2.Value = "" Then
MsgBox "「個数」は必須項目です。"
End If

If TextBox2.Value = "0" Then
MsgBox "「個数」に0は登録できません。"
End If

Lrow = Range("B2").CurrentRegion.Rows.Count

Range("B" & Lrow + 1).Value = TextBox1.Value
Range("C" & Lrow + 1).Value = TextBox2.Value

End Sub

Private Sub CommandButton2_Click()
Unload UserForm1
End Sub

Private Sub UserForm_Initialize()
Dim b As Long
Dim a() As String
ReDim a(1 To 100)

UserForm1.ListBox1.ColumnCount = 2
UserForm1.ListBox1.List = Worksheets(Sheet1).Range("B2:C").Value

For i = 2 To 104
If Range("B" & i) = "" Then
ListBox1.AddItem Range("B" & i).Value
ListBox1.AddItem Range("c" & i).Value
b = b + 1
a(b) = Range("C" & i).Value

End If
Next i

End Sub

このコードでSheet1上のコマンドボタンを押して実行しようとするとエラーが出てしまいます。
エラーの原因は何なのでしょうか？
（なお、コマンドボタンのコードは「UserForm1.Show」のみです。

コード自体は本などを読みながら似たようなVBAを使った物を参考にしています。

回答No.2

tsubuyuki · ベストアンサー

遅れまして申し訳ないです。
ご提示のコードを試してみました。

確かに、
> 「実行時エラー　'13':型が一致しません」
そのエラーで止まりますね。

なので、
Sub ボタン1_Click()
　　　　UserForm1.Show
End Sub
からステップインモードで走らせてみました。

すると「ＶＢＡ中で処理できなかった行」は
> UserForm1.ListBox1.List = Worksheets(Sheet1).Range("B2:C").Value
ここです。

これが完全ＶＢＥでにコピー、質問文作成画面に貼り付けで手を加えていないとすると・・
おかしい点が二つほど。

ワークシートを指定するときは「WorkSheets("Sheet1")　シート名を直接」
あるいは「WorkSheets(1)　シートの位置で指定」のどちらかでしたね。
つまり、ダブルクォーテーションが抜けていますね。

もうひとつ。
「Range("B2:C")」ってどこのことでしょう？
範囲の終端が抜けていますね。

これを適宜修正してやれば、動くと思いますよ。
（少なくとも当方では動作確認できました。）

ついでに、お節介ながら豆知識。
Cells(Rows.Count, 2).End(xlUp).Row　　これで、Ｂ列の最終行を
Cells(1, Columns.Count).End(xlToLeft).Column　　これで、１行目の最終列を
それぞれ取得できます。

これを利用して、例えば
Sub Sample()
Dim LRow As Long
　　　　LRow = Cells(Rows.Count, 3).End(xlUp).Row
　　　　Range("B2:C" & LRow).Select
End Sub
として動かしてやると、「Ｂ２せるからＣ列の最終行まで」を選択できます。
いろいろな場面で重宝しますから、覚えておくと便利に使えますよ。
今回も使えそうですね。

Private Sub UserForm_Initialize()
Dim b As Long
Dim a() As String
ReDim a(1 To 100)
Dim LRow As Long ' 追加
LRow = Cells(Rows.Count, 3).End(xlUp).Row ' 追加
UserForm1.ListBox1.ColumnCount = 2
UserForm1.ListBox1.List = Worksheets("Sheet1").Range("B2:C" & LRow).Value '修正

For i = 2 To LRow ' 修正・・でも、この下は何をしたいコードでしょう？
If Range("B" & i) = "" Then
ListBox1.AddItem Range("B" & i).Value
ListBox1.AddItem Range("c" & i).Value
b = b + 1
a(b) = Range("C" & i).Value
End If
Next i
End Sub

もうついでですし。

Private Sub CommandButton1_Click()
If TextBox1.Value = "" Then
MsgBox "「名称」は必須項目です。"
End If
～省略～
Range("B" & Lrow + 1).Value = TextBox1.Value
Range("C" & Lrow + 1).Value = TextBox2.Value

UserForm_Initialize　　' 追加
End Sub

してやると、登録したついでにリストボックスを更新してくれますよ。

以上、参考までに。

お礼

非常に詳しく説明して頂き助かります。ありがとうございます！

最終列や最終行の選択ができるのは便利ですね。いいことを覚える事ができました。

一応、MSZ006さんの案とtsubuyukiさんの案を複合して、VBAのコードを作成し、思い通りに動く事を確認しました。

本当にありがとうございます。

回答No.3

MSZ006

まずは、Sheet1上のコマンドボタンのコーディングは「UserForm1.Show」だけではダメだと思います。

１） UserForm1をロード
２） UserForm1上のListBox1にデータをセット
３）UserForm1を表示

という流れです。
UserForm_Initialize()はどこで呼び出されているのでしょうか？これを上記２）で呼ぶのだと思われます。
が、このUserForm_Initialize()にも問題があります。

調整は必要ですが、とりあえずは下記のコードでここまで（シート上のボタンを押すとフォームが現れる）は動くと思います。

Private Sub CommandButton1_Click()
Load UserForm1
Call UserForm_Initialize
UserForm1.Show
End Sub

Private Sub UserForm_Initialize()
Dim b As Long
Dim a() As String
ReDim a(1 To 100)

UserForm1.ListBox1.ColumnCount = 2

UserForm1.ListBox1.List = Worksheets("Sheet1").Range("B2:C102").Value

　'For i = 2 To 104
' If Worksheets("Sheet1").Range("B" & i) <> "" Then
' UserForm1.ListBox1.AddItem Worksheets("Sheet1").Range("B" & i).Value
' UserForm1.ListBox1.AddItem Worksheets("Sheet1").Range("C" & i).Value
' b = b + 1
' a(b) = Range("C" & i).Value
' End If
'Next i

End Sub

次にUserForm1のほうのコーディングです。

名称と数量の入力チェックをしているのはいいですが、NGのときでも下まで処理が行ってしまうので、NGのときは途中でこの処理から抜け出す必要があります。Exit Subを追加します。

Private Sub CommandButton1_Click()
If TextBox1.Value = "" Then
MsgBox "名称は必須です"
Exit Sub
End If

If TextBox2.Value = "" Then
MsgBox "数量は必須です"
Exit Sub
End If

If TextBox2.Value = "0" Then
MsgBox "数量は0はだめ"
Exit Sub
End If

Lrow = Worksheets("sheet1").Range("B2").CurrentRegion.Rows.Count

Range("B" & Lrow + 1).Value = TextBox1.Value
Range("C" & Lrow + 1).Value = TextBox2.Value

'下記２行追加でリストボックスが即時更新されます
UserForm1.ListBox1.List = Worksheets("Sheet1").Range("B2:C103").Value
DoEvents

End Sub

Private Sub CommandButton2_Click()
Unload UserForm1
End Sub

お礼

詳しく説明及び回答ありがとうございます。

NG時にExit subを入れる、というのは盲点でした＞＜　覚えておきます。

本当はお二方どちらにもベストアンサーを差上げたいのですが、先に回答を頂けた、No.1,2の型にさせて頂きました。

教えていただいたことを忘れずにさらに精進していきます。

回答No.1

tsubuyuki

どのコードの、どの行で、どんなメッセージを吐いて、止まりますか？

それによって対処が変わりますよ？

補足

申訳ありません。

Sheet1上のコマンドボタンを押すと、
「実行時エラー　'13':型が一致しません」
と出ます。

デバックで見てみると、
Sheet1上のコマンドボタンのコードの「UserForm1.Show」の部分で止っています。