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

解決済みの質問

Excel VBAで抽出コンボって無理ですか?

簡単な発注システムを作成しようとしています。
Accessはあまり詳しくないので、できればExcel VBAで作りたいと思います。

その中で、2つのコンボボックスおよびをユーザーフォーム内に配置し、片方には発注先(Combo1)を、もう片方には担当者名(Combo2)を選択入力したいと考えています。
1つの発注先に対して複数の担当者がいる場合、別シートに下のようなフィールドを持つテーブルを用意しました。
発注先  担当者
A社   佐藤
A社   田中
B社   渡辺
B社   後藤
B社   鈴木
C社   中村

ここで、発注先としてB社を選択した場合、Combo2からは渡辺,後藤,鈴木だけが選択できるようにしたいのですがこのような処理はExcelでは無理でしょうか?
やはりAccessでクエリを使って処理した方が良いでしょうか?
どなたかご指南願います。Excel2002を使用しています。

投稿日時 - 2002-10-04 17:00:05

QNo.373244

困ってます

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

早速ご質問にお答えしたいと思います。
私の作成ミスで申し訳ございませんでした。前回のコードに記述ミスがありました。修正マクロを作ってみましたので、参考にしてみて下さい。

Private Sub Cmb1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Dim myCell As String
Dim myRange As Range
Dim myRow As Integer
Dim myClm As Integer
Dim i As Integer

Me.Cmb2.Clear
myCell = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Address
Set myRange = ActiveWorkbook.Worksheets(1).Range("A1:" & myCell).Find(Me.Cmb1.Text, lookat:=xlWhole)
If myRange Is Nothing Then
MsgBox "発注先の入力が正しくありません。", vbOKOnly + vbCritical, "入 力 エ ラ ー"
Me.Cmb1.Text = "": Cancel = True: Exit Sub
Else
myRow = myRange.Row
End If

myClm = ActiveWorkbook.Worksheets(1).Cells(myRow, Columns.Count).End(xlToLeft).Column
For i = 2 To myClm
Me.Cmb2.AddItem (ActiveWorkbook.Worksheets(1).Cells(myRow, i).Value)
Next i

これで、あなた様が問題と思われた内容がすべて訂正され、あなた様が思われているような動作をすると思います。

また、不都合な点がございましたらお知らせ下さい。

投稿日時 - 2002-10-06 05:10:12

お礼

kazuhiko5681様、大変丁寧な回答をありがとうございました。VBAはかじり始めたばかりでまだ十分理解できていませんが、ご回答いただいた例を参考にして、勉強しながらがんばりたいと思います。

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

投稿日時 - 2002-10-07 01:46:11

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

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

回答(4)

ANo.3

はじめまして。あなた様のやりたいことを実現することができるサンプルマクロを作ってみました。次の方法で操作してみて下さい。

1.新規ブックを立ち上げる。
2.Sheet1のA2にA社・B2に佐藤・C2に田中A3にB社B3に渡辺・C3に後藤・D3に鈴木というようにA列に発注先・B列~C列・D列・・に担当者名を入力する表を作る。
3.VBE画面を立ち上げ、ユーザーフォームを追加し、フォーム上にコンボボックスを2個配置し、プロパティウインドウからオブジェクト名をそれぞれCmb1・Cmb2と変更する。
4.フォームをダブルクリックしてフォームモジュールを表示させ、そこに下記のコードをコピー・ペーストする。

Private Sub Cmb1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Dim myCell As String
Dim myRange As Range
Dim myRow As Integer
Dim myClm As Integer
Dim i As Integer

myCell = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Address
Set myRange = ActiveWorkbook.Worksheets(1).Range("A1:" & myCell).Find(Me.Cmb1.Text, lookat:=xlWhole)
If myRange Is Nothing Then
MsgBox "発注先の入力が正しくありません。", vbOKOnly + vbCritical, "入 力 エ ラ ー"
Me.Cmb1.Text = "": Cancel = True
Else
myRow = myRange.Row
End If

myClm = ActiveWorkbook.Worksheets(1).Cells(myRow, Columns.Count).End(xlToLeft).Column
For i = 2 To myClm
Me.Cmb2.AddItem (ActiveWorkbook.Worksheets(1).Cells(myRow, i).Value)
Next i

End Sub

5.F5キーを押してフォームを立ち上げ、Cmb1に発注先を入力し、Cmb2にフォーカスを移す。
6.Cmb2の右にある▼ボタンをクリックする。

あなた様のやりたいことが実現しているはずです。

もし違っていたり、不都合なことがありましたら、ご遠慮なくお知らせ下さい。私でよろしければ、あなた様のやられたいことが実現するまで一緒に考えていきたいと思います。

投稿日時 - 2002-10-05 01:40:11

お礼

kazuhiko5681様、素晴らしい回答をありがとうございます。確認したところ私の思い通りの動作であり、感激しています!
ところで欲を出して申し訳ないのですが、入力エラー処理の後エラーで止まってしまうのですが、これはExit Subで抜けて構わないでしょうかね?
あと、Cmb1のフォーカスを解除するとCmb2のリストが作成されるので、A社を選んだ後、一旦Cmb1のフォーカスを外し、今度はB社を選んだ場合、A社の担当者とB社の担当者が重複してCmb2のリストに登録されてしまいます。これは・・・Cmb1のChangeイベントを受けてCmb2のリストをその都度消去すればいいと思うのですが、
cmb2.Rowsource=""
とかやっても消えてくれません。
無知ですみませんが適切な処理方法をご教授願いませんでしょうか?
よろしくお願いします。

投稿日時 - 2002-10-06 02:37:55

ANo.2

Sheet1で何か処理を行い、ユーザーフォームを表示し、質問の表はSheet2にあるとします。同一のシートであっても問題はないでしょう。

Sheet2のA1から、質問にあるデータを入力しておきます。
A列は発注先、B列は担当者、データは2行目からです。
発注先担当者
A社佐藤
A社田中
B社渡辺
B社後藤
B社鈴木
C社中村

Sheet1に起動用のボタンを作ります。
Private Sub CommandButton1_Click()
  UserForm1.Show
End Sub

ユーザーファーム(UserForm1)にコンボボックスを2つ貼り付けます。Combo1(発注先用)とCombo2(担当者用)

ほとんど似たコードですが、下のコードをユーザーフォームのコードウインドウに貼り付けます。
説明が面倒になるので、AdvancedFilterは何もオプションをつけずに使っています。
データを絞り込む手段はたくさんあるでしょう。(Excel2000です)


ここから

Dim ws2 As Worksheet '発注先と担当者が登録されたワークシート
Dim rg As Range 'セル

Private Sub UserForm_Initialize()
  Set ws2 = Worksheets("Sheet2")
  Application.ScreenUpdating = False
  'コンボボックスのリストを抽出(発注先)
  ws2.UsedRange.Columns(1).AdvancedFilter xlFilterInPlace, , , True

  With Combo1
    .Clear
    For Each rg In ws2.UsedRange.Columns(1).SpecialCells(xlCellTypeVisible)
      If rg.Row <> 1 Then .AddItem rg.Value
    Next
    .ListIndex = 0
  End With
  Application.ScreenUpdating = True
End Sub

Private Sub Combo1_Click()
  Application.ScreenUpdating = False
  'コンボボックスのリストを抽出(担当者)
  ws2.UsedRange.Columns(2).AdvancedFilter xlFilterInPlace, , , True
  With Combo2
    .Clear
    For Each rg In ws2.UsedRange.Columns(2).SpecialCells(xlCellTypeVisible)
      If rg.Row <> 1 Then
        If rg.Offset(0, -1) = Combo1.Text Then
          .AddItem rg.Value
        End If
      End If
    Next
    .ListIndex = 0
  End With
  Application.ScreenUpdating = True
End Sub

投稿日時 - 2002-10-04 22:43:31

お礼

回答ありがとうございます。
ちょっと難しそうですが、この方法ならできそうな気がします。

AdvancedFilterというのも初めて知りましたし、AddItemでリストに追加するというのは思いつきませんでした。まだまだ修行が足りません。色々勉強しながら取り組みたいと思います。
本当にありがとうございました。

投稿日時 - 2002-10-05 00:43:35

ANo.1

仮にSheet1(別シートらしいですが)に以下のようなデータを入力します。

    A   B   C

1  A社  A社  佐藤
2  B社  A社  田中
3  C社  B社  渡辺
       B社  後藤
       B社  鈴木
       C社  中村

Comboboxに表示されるリストを指定するにはRowSourceを使います。

例えば、
Private Sub ComboBox1_Change()
If ComboBox1 = "A社" Then
ComboBox2.RowSource = "Sheet1!C1: C2"
ElseIf ComboBox1 = "B社" Then
ComboBox2.RowSource = "Sheet1!C3: C5"
ElseIf ComboBox1 = "C社" Then
ComboBox2.RowSource = "Sheet1!C6"
Else
End If
End Sub

のように使います。もちろんComboBox1も"Sheet1!A1: A3"で指定します。
後の処理(結果がどこに書き込まれるか)は書いていませんが質問の部分にはお答えしたつもりです。
ではがんばって下さいね。

投稿日時 - 2002-10-04 17:42:36

補足

素早い回答ありがとうございます。
RowSourceプロパティで指定するのは判っているのですが、発注先はとてもたくさん登録されている上に、新規の発注先や担当者が登録される可能性があるので、直接
If ComboBox1 = "A社" Then
ComboBox2.RowSource = "Sheet1!C1: C2"
のようには指定できないのです。
まず、リストの中からA社ならA社に属する担当者リストを抽出した上で、Combo2のRowSourceに設定しなければならないと思うのです。
う~ん・・・無理かな?(^^;

投稿日時 - 2002-10-04 17:55:26

あなたにオススメの質問