エクセル VBA if構文

毎度お世話になります。
下記プログラミングですが、
シャーペンまたはボールペンがコンボボックス1で
選択された場合はコンボボックス2で10束または50束の選択肢となり
消しゴムまたはシャー芯がコンボボックス2で
選択された場合はコンボボックス2で100コまたは1000コの選択肢としたいのですが
他の方法がありますでしょうか。
宜しくお願い致します。

If Me.ComboBox1.Value = "シャーペン" Or Me.ComboBox1.Value = "ボールペン" Then
ComboBox2.Style = fmStyleDropDownCombo
ComboBox2.RowSource = ""
ComboBox2.Clear
ComboBox2.AddItem "10束"
ComboBox2.AddItem "50束"
ComboBox2.ListIndex = -1
End If

If Me.ComboBox1.Value = "消しゴム" Or
Me.ComboBox1.Value = "シャー芯" Then
ComboBox2.Style = fmStyleDropDownCombo
ComboBox2.RowSource = ""
ComboBox2.Clear
ComboBox2.AddItem "100コ"
ComboBox2.AddItem "1000コ"
ComboBox2.ListIndex = -1
End If

No.3 ベストアンサー 回答者： fumufumu_2006 回答日時： 2008/04/17 17:54

こんなのはどうでしょうか？

Sheet2を用意してください。
まず、A1:B4セルに次の値を入力してください。
A1=シャーペン
A2=ボールペン
A3=消しゴム
A4=シャー芯
B1=C
B2=C
B3=D
B4=D
次に
C列を選んで[書式][セル]の[表示形式]タブを選んで[ユーザー定義]で [#"束"]を入力してください。
C1=10
C2=50
D列を選んで[書式][セル]の[表示形式]タブを選んで[ユーザー定義]で [#"コ"]を入力してください。
D1=100
D2=1000
以上で、下記のような表ができます。
シャーペンC10束100コ
ボールペンC50束1000コ
消しゴムD
シャー芯D

ComboBox1のListFillRangeプロパティに
Sheet2!A1:B4
と入力してください。

で、コンボボックスがあるシートに以下のVBAをコピーしてください。
Private Sub ComboBox1_Change()
Const dataSheet = "Sheet2"
Dim col As String
col = ComboBox1.List(ComboBox1.ListIndex, 1)
ComboBox2.ListFillRange = dataSheet & "!" & col & "1:" & col & Sheets(dataSheet).Cells(Sheets(dataSheet).Rows.Count, col).End(xlUp).Row
ComboBox2.ListIndex = -1
End Sub
にしてください。

以上です。
後はSheet2のC列やD列に100行でも1000行でも好きなだけデータを入れれば、コンボボックス2の選択肢ができます。
必要に応じてA:B列にデータを追加すれば、コンボボックス1もデータを追加できます。

ちなみに、自動的にコンボボックス1のListFillRangeプロパティを設定するプログラムです。
Sub SetComboBox1List()
Const dataSheet = "Sheet2"
ComboBox1.ListFillRange = dataSheet & "!A1:B" & Sheets(dataSheet).Cells(Sheets(dataSheet).Rows.Count, 1).End(xlUp).Row
ComboBox2.ListIndex = -1
End Sub

この回答への補足

御教示ありがとうございます。
Private Sub ComboBox1_Change()
コンパイルエラーが発生してしまいます。
シートにコンボボックス設置しているのではなく
ユーザーフォームに設置しているのですが
この場合、プログラムが変わってきますでしょうか。
宜しくお願い致します。

補足日時：2008/04/18 14:08

No.7 回答者： imogasi 回答日時： 2008/04/20 00:34

VBAであれば関数MATCHが使えます。

A列　　　　B列　　　　　C列　　　D列
シャーペン　１０束　　　５０束
ボールペン　１０束　　　５０束
シャー芯　　１００個　　１０００個
消しゴム　　１００個　　１０００個
・・
を作っておき
シートにコンボ１、コンボ２を張り付ける。
標準モジュール
Sub test01()
For i = 1 To 5
Worksheets("Sheet1").ComboBox1.AddItem Cells(i, "G")
Next i
End Sub
を実行。
Sheet1のコントロールのイベントに
Private Sub ComboBox1_Change()
MsgBox Worksheets("sheet1").ComboBox1.Value
For j = 8 To 8 + 4
x = Application.WorksheetFunction.Match(Worksheets("sheet1").ComboBox1.Value, Worksheets("Sheet1").Range("G1:G10"), 0)
If Cells(x, j) = "" Then
Exit Sub
Else
Worksheets("sheet1").ComboBox2.AddItem Cells(x, j)
End If
Next j
End Sub

No.6 回答者： fumufumu_2006 回答日時： 2008/04/19 02:02

ANo.4です。

>Private Sub ComboBox1_Change()
>ここがコンパイルエラーになるので
>1を2に変更したところコンボボックス1に
>A列が反映されたのですが、B列には何も反映されてきません
「名前が適切ではありません．ComboBox1_Change」というエラーなら、同じウインドウ内に
Private Sub ComboBox1_Change()
・・・
End Sub
のモジュールが既にないか確認してください。
または、2つのコンボボックスのオブジェクト名がComboBox1とComboBox2になっているか確認してください。
通常新規のユーザーフォームに２つのコンボボックスを作るとComboBox1とComboBox2になります。
しかし、既にあるコンボボックスを削除して新たに作成したりすると違う名前になります。
サンプルはオブジェクト名がComboBox1とComboBox2であるという前提で作成しています。
プロパティウインドウのオブジェクト名の所で変更できます。

慣れたらオブジェクト名を「cmb商品」「cmb数量」とかにしてプログラムを作ると、下のようになって意味がわかりやすくなります。
'商品数選択の設定
Private Sub cmb商品_Change()
Const dataSheet = "Sheet2"'「Sheet2」も「商品コンボデータ」とかに変えるとわかりやすい
Dim col As String
col = cmb商品.List(cmb商品.ListIndex, 1)
cmb数量.RowSource = dataSheet & "!" & col & "1:" & col & Sheets(dataSheet).Cells(Sheets(dataSheet).Rows.Count, col).End(xlUp).Row
cmb数量.ListIndex = -1
End Sub
'初期設定
Private Sub UserForm_Initialize()
'商品選択の初期化
Const dataSheet = "Sheet2"
cmb商品.RowSource = dataSheet & "!A1:B" & Sheets(dataSheet).Cells(Sheets(dataSheet).Rows.Count, 1).End(xlUp).Row
cmb商品.ListIndex = -1
End Sub

No.5 回答者： fumufumu_2006 回答日時： 2008/04/18 15:23

ANo.4です。

>ユーザーフォームのComboBox1のRowSourceプロパティに
>Sheet2!A1:B4
>と入力してください。

UserForm_Initializeで自動的に設定しているので、上の部分いりません。
設定していても問題ないですけれど。

No.4 回答者： fumufumu_2006 回答日時： 2008/04/18 15:18

ANo.3です。

ユーザーフォームの場合はListFillRangeがRowSourceになります。
Sheet2はそのままです。
ユーザーフォームのComboBox1のRowSourceプロパティに
Sheet2!A1:B4
と入力してください。

vba部分は

'ComboBox2設定
Private Sub ComboBox1_Change()
Const dataSheet = "Sheet2"
Dim col As String
col = ComboBox1.List(ComboBox1.ListIndex, 1)
ComboBox2.RowSource = dataSheet & "!" & col & "1:" & col & Sheets(dataSheet).Cells(Sheets(dataSheet).Rows.Count, col).End(xlUp).Row
ComboBox2.ListIndex = -1
End Sub

'ComboBox1設定
Private Sub UserForm_Initialize()
Const dataSheet = "Sheet2"
ComboBox1.RowSource = dataSheet & "!A1:B" & Sheets(dataSheet).Cells(Sheets(dataSheet).Rows.Count, 1).End(xlUp).Row
ComboBox2.ListIndex = -1
End Sub

これで試してみてください。

この回答への補足

たびたびありがとうございます。
Private Sub ComboBox1_Change()
ここがコンパイルエラーになるので
1を2に変更したところコンボボックス1に
A列が反映されたのですが、B列には何も反映されてきません。
どのように対処するのが宜しいでしょうか。
お手数をお掛け致しますがお願い致します。

補足日時：2008/04/18 15:49

No.2 回答者： onlyrom 回答日時： 2008/04/17 16:43

質問者のコードでは、Combo1の選択肢が増えるに比例して、

コードも増えていくうえにそのたびにコードの書き換えが
必要になり、汎用的ではありません。
このような場合には以下のようなテーブルを用意し、
それを参照させるようにするのが一般的だと考えます。

Sheet２　に次のようなテープルを作成しておき、
これをCombo1の選択値によりCombo2にセットする。

＿＿＿＿Ａ＿＿＿Ｂ＿＿＿Ｃ＿＿＿Ｄ＿＿
１＿＿りんご＿みかん＿バナナ＿レモン
２＿＿５５箱＿３３個＿２４房＿３５コ
３＿＿６６箱＿５３個＿３４房＿４５コ
４＿＿７７箱＿７３個＿４４房＿＿＿＿
５＿＿８８箱＿９３個＿＿＿＿＿＿＿＿
６＿＿９９箱＿＿＿＿＿＿＿＿＿＿＿＿


で、以下のコードを無条件？にコピペ。

　
'------UserFormのInitializeイベント----------
Private Sub UserForm_Initialize()
　Dim C As Integer
　With Sheets("Sheet2")
　　ComboBox1.Clear
　　For C = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
　　　ComboBox1.AddItem .Cells(1, C).Value
　　Next C
　End With
End Sub

'---------ComboBox1のChangeイベント -------
Private Sub ComboBox1_Change()
　Dim Clm As Integer
　Dim R As Long
　With Sheets("Sheet2")
　　ComboBox2.Clear
　　Clm = .Rows(1).Find(ComboBox1.Value, , xlValues, xlWhole).Column
　　For R = 2 To .Cells(.Rows.Count, Clm).End(xlUp).Row
　　　ComboBox2.AddItem .Cells(R, Clm).Value
　　Next R
　End With
End Sub
'-------------------------------------------

テーブルを使うと質問のようにシャーペン、ボールペンが
Combo２において同じ選択肢を取るとしても、変換テーブル
のシャーペン、ボールペンのところに、同じ選択肢を入れ
ておけば、わざわざ、ＩＦ文を使う必要がなくなるわけです。

また、選択肢をセットするときには、Listプロパティや、
RowSourceプロパティという便利なものがありますので、
序にそれも調べておきましょう。

●Listプロパティを使う方法
'----------------------------------------------
Private Sub UserForm_Initialize()
　Dim Rng As Range
　With Sheets("Sheet2")
　　Set Rng = .Cells(1, .Columns.Count).End(xlToLeft)
　　ComboBox1.List = WorksheetFunction.Transpose(.Range("A1", Rng).Value)
　End With
End Sub
'---------------------------------------------
Private Sub ComboBox1_Change()
　Dim Clm As Integer
　Dim LastRow As Long
　With Sheets("Sheet2")
　　Clm = .Rows(1).Find(ComboBox1.Value, , xlValues, xlWhole).Column
　　LastRow = .Cells(.Rows.Count, Clm).End(xlUp).Row
　　ComboBox2.List = .Range(.Cells(2, Clm), .Cells(LastRow, Clm)).Value
　End With
End Sub
'-------------------------------------------

以上。
　
　

この回答へのお礼

拡張性を考えたときにはNo3の方のものが
良いと考えそちらでやってみたいと思います。
御教示ありがとうございました。

お礼日時：2008/04/18 14:16

No.1 回答者： noname#140971 回答日時： 2008/04/17 11:47

Private Sub ComboBox1_Change()

　　Dim strSelValue As String
　　Dim intSelGroup As Integer
　　
　　If Len(Me.ComboBox1.Value & "") Then
　　　　strSelValue = Me.ComboBox1.Value
　　　　intSelGroup = 2 - Abs(InStr(1, "シャーペン/ボールペン", strSelValue, vbTextCompare) > 0)
　　　　Me.ComboBox2.Clear
　　　　Me.ComboBox2.AddItem CutStr("10束/100コ", "/", intSelGroup)
　　　　Me.ComboBox2.AddItem CutStr("50束/1000コ", "/", intSelGroup)
　　　　Me.ComboBox2.ListIndex = -1
　　End If
End Sub

改善点１、Me.ComboBox1.Value　がヌル値の場合はComboBox2の再設定をしていない。
改善点２、Me.ComboBox1.Value　の参照を一度としている。
　　　　　strSelValue　への代入は事実上必要ありません。（ここでは、コードを簡略化する効果のみ！）
改善点３、選択されたグループが１か２かを判定する行を設けでIF THEN の分岐を無用にしている。
改善点４、ムダなスタイル設定と二重クリアのバグを訂正。
改善点５、CutStr関数を利用し、１と２で追加するアイテムを判りやすくしている

　　　　Me.ComboBox2.ListIndex = 0

普通は、Me.ComboBox2の先頭アイテムが選択された状態で初期化すると思います。

なお、標準モジュールに以下のCutStr関数を追加してテストしています。

Public Function CutStr(ByVal Text As String, _
　　　　　　　　　　　 ByVal Separator As String, _
　　　　　　　　　　　 ByVal N As Integer) As String
　　Dim strDatas() As String
　　
　　strDatas = Split("" & Separator & Text, Separator, , 0)
　　CutStr = strDatas(N * Abs((N <= UBound(strDatas))))
End Function

この回答へのお礼

ありがとうございます。
うまくいきませんでした。^^;
No3方の方法でやってみたいと思います。

お礼日時：2008/04/18 14:13