こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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(入力された「名称」と「個数」をSheet1の表の一番下に追加)、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を使った物を参考にしています。

投稿日時 - 2013-06-19 13:30:23

QNo.8140578

困ってます

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

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

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

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

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

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

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

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

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



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

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

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

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



以上、参考までに。

投稿日時 - 2013-06-19 15:00:07

お礼

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

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

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

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

投稿日時 - 2013-06-20 11:07:51

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

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

1) UserForm1をロード
2) UserForm1上のListBox1にデータをセット
3)UserForm1を表示

という流れです。
UserForm_Initialize()はどこで呼び出されているのでしょうか?これを上記2)で呼ぶのだと思われます。
が、この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

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

End Sub

Private Sub CommandButton2_Click()
Unload UserForm1
End Sub

投稿日時 - 2013-06-19 15:16:35

お礼

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

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

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

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

投稿日時 - 2013-06-20 11:10:22

ANo.1

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

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

投稿日時 - 2013-06-19 13:43:09

補足

申訳ありません。

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

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

投稿日時 - 2013-06-19 13:56:46

あなたにオススメの質問