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

解決済みの質問

エクセル 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

投稿日時 - 2008-04-16 21:23:42

QNo.3953103

困ってます

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

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

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

投稿日時 - 2008-04-17 17:54:53

補足

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

投稿日時 - 2008-04-18 14:08:01

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

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

回答(7)

ANo.7

VBAであれば関数MATCHが使えます。
A列    B列     C列   D列
シャーペン 10束   50束
ボールペン 10束   50束
シャー芯  100個  1000個
消しゴム  100個  1000個
・・
を作っておき
シートにコンボ1、コンボ2を張り付ける。
標準モジュール
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

投稿日時 - 2008-04-20 00:34:05

ANo.4です。

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

投稿日時 - 2008-04-19 02:02:06

ANo.4です。

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

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

投稿日時 - 2008-04-18 15:23:08

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

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

投稿日時 - 2008-04-18 15:18:48

補足

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

投稿日時 - 2008-04-18 15:49:13

ANo.2

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

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

____A___B___C___D__
1__りんご_みかん_バナナ_レモン
2__55箱_33個_24房_35コ
3__66箱_53個_34房_45コ
4__77箱_73個_44房____
5__88箱_93個________
6__99箱____________


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

 
'------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
'-------------------------------------------

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

また、選択肢をセットするときには、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
'-------------------------------------------

以上。
 
 

投稿日時 - 2008-04-17 16:43:44

お礼

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

投稿日時 - 2008-04-18 14:16:04

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

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

    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

投稿日時 - 2008-04-17 11:47:38

お礼

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

投稿日時 - 2008-04-18 14:13:18

あなたにオススメの質問