Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9373 / 13644 ツリー ←次へ | 前へ→

【27741】ComboBoxの並び替え ohana 05/8/17(水) 16:02 質問[未読]
【27753】Re:ComboBoxの並び替え m2m10 05/8/18(木) 8:17 発言[未読]
【27754】Re:ComboBoxの並び替え だるま 05/8/18(木) 9:17 発言[未読]
【27762】Re:ComboBoxの並び替え ohana 05/8/18(木) 15:44 お礼[未読]
【27761】Re:ComboBoxの並び替え ohana 05/8/18(木) 15:42 お礼[未読]

【27741】ComboBoxの並び替え
質問  ohana  - 05/8/17(水) 16:02 -

引用なし
パスワード
   こんにちわ。おじゃまします。
すみませんが、教えていただけないでしょうか・・・。
1.複数のシートから呼び出したコンボボックスの全リストの並び替え
2.どのコンボボックスから入力しても反応してほしい
ということなのですが。

メーカー名(ComboBox4)・商品名(Combobox5)・規格(ComboBox6)・入数(textBox2)etc・・・ の情報が入ったシートが複数あります。(増える可能性大)
その複数のシートから重複しないリストをComboboxにListを表示させています。
1文字目を入れて、Enterを押すとその文字の1番目がComboBoxに表示されます。

初期値には以下のモジュールを記述しました。
'Combobox4(メーカー)5(品名)6(規格)の設定
ComboBox4.Clear
ComboBox5.Clear
ComboBox6.Clear

For UFI_WSC = 1 To Worksheets.Count
If Worksheets(UFI_WSC).Range("A1").Value = "メーカー名" Then
↑いろんなシートがブックに含まれている為、セルA1がメーカー名のシートだけを
 対象にしてもらいます。
  UFI_Lst = Worksheets(UFI_WSC).Range("B65536").End(xlUp).Row
  Set MyRange = Worksheets(UFI_WSC).Range("B2:B" & UFI_Lst)
    
  On Error Resume Next
  For Each MyRan In MyRange
   MyAddA.Add MyRan, CStr(MyRan.Value) 'メーカー
   MyAddB.Add MyRan.Offset(, 1), CStr(MyRan.Offset(,1).Value) '品名 
   MyAddC.Add MyRan.Offset(, 2), CStr(MyRan.Offset(,2).Value) '規格
  Next MyRan
  On Error GoTo 0
  MemCouA = MyAddA.Count
  MemCouB = MyAddB.Count
  MemCouC = MyAddC.Count
  Application.EnableEvents = False
    For UFI_MA = 1 To MemCouA
      ComboBox4.AddItem MyAddA(UFI_MA).Value
    Next UFI_MA
    For UFI_MB = 1 To MemCouB
    
      ComboBox5.AddItem MyAddB(UFI_MB).Value
    Next UFI_MB
    For UFI_MC = 1 To MemCouC
      ComboBox6.AddItem MyAddC(UFI_MC).Value
    Next UFI_MC
  Application.EnableEvents = True
  Set MyRange = Nothing
  Set MyR = Nothing
  Set MyAddA = Nothing
  Set MyAddB = Nothing
  Set MyAddC = Nothing
End If
Next UFI_WSC
End Sub

これでは、シートを順番に見に行くので、ComboBoxには、
Sheet1のMyAddA
Sheet2のMyAddA
・・・
の昇順が表示されてしまいます。
全体の昇順を表示させるにはどうすればいいのでしょう。

もう一つ、どのComboboxからでも反応して欲しいのですが、
入力しなおしたりすると、重複したり、先に入れていたコンボボックスが空になったりするのです。コンボボックスをClearにするタイミングがわからないんです。

Private Sub ComboBox4_Change()
Dim LastRow As Long
Dim WSCount As Integer

ComboBox5.Clear
ComboBox6.Clear

For WSCount = 1 To Worksheets.Count
If Worksheets(WSCount).Range("B1").Value = "メーカー名" Then
  
  LastRow = Worksheets(WSCount).Range("B65536").End(xlUp).Row
  Set MyRange = Worksheets(WSCount).Range("B2:B" & LastRow)
  MyCom = ComboBox4.Value
  
  On Error Resume Next
  For Each MyR In MyRange
    If MyR = MyCom Then
    MyAddA.Add MyR.Offset(, 1), CStr(MyR.Offset(, 1).Value) '商品名
    MyAddB.Add MyR.Offset(, 2), CStr(MyR.Offset(, 2).Value) '規格
    End If
  Next MyR
    
  On Error GoTo 0
  MemCouA = MyAddA.Count
  MemCouB = MyAddB.Count
  Application.EnableEvents = False
    For UFI_MA = 1 To MemCouA
      ComboBox5.AddItem MyAddA(UFI_MA).Value
    Next UFI_MA
    For UFI_MB = 1 To MemCouB
      ComboBox6.AddItem MyAddB(UFI_MB).Value
    Next UFI_MB
  Application.EnableEvents = True
  Set MyRange = Nothing
  Set MyR = Nothing
  Set MyAddA = Nothing
  Set MyAddB = Nothing
End If
Next WSCount
End Sub

Private Sub ComboBox5_Change()
Dim LastRow As Long
Dim Meka As String

If ComboBox4.Value = "" Then ComboBox4.Clear
If ComboBox6.Value = "" Then ComboBox6.Clear

For WSCount = 1 To Worksheets.Count
If Worksheets(WSCount).Range("A1").Value = "分類" Then

  LastRow = Worksheets(WSCount).Range("C65536").End(xlUp).Row
  Set MyRange = Worksheets(WSCount).Range("C2:C" & LastRow)
  MyCom = ComboBox5.Value

  On Error Resume Next
  For Each MyR In MyRange
    If MyR = MyCom Then
    MyAddA.Add MyR.Offset(, -1), CStr(MyR.Offset(, -1).Value) 'メーカ名
    MyAddB.Add MyR.Offset(, 1), CStr(MyR.Offset(, 1).Value)  '規格
    MyAddC.Add MyR.Offset(, -2), CStr(MyR.Offset(-2).Value) '分類
    End If
  Next MyR
  
  On Error GoTo 0
  MemCouA = MyAddA.Count
  MemCouB = MyAddB.Count
  MemCouC = MyAddC.Count

  Application.EnableEvents = False
    For UFI_MA = 1 To MemCouA
       ComboBox4.AddItem MyAddA(UFI_MA).Value
    Next UFI_MA
    For UFI_MB = 1 To MemCouB
      ComboBox6.AddItem MyAddB(UFI_MB).Value
    Next UFI_MB
    
  Application.EnableEvents = True
  Set MyRange = Nothing
  Set MyR = Nothing
  Set MyAddA = Nothing
  Set MyAddB = Nothing
  Set MyAddC = Nothing
End If
Next WSCount
End Sub

長くて、わかりずらい文章ですみません。
どうか助言をよろしくお願いします。

【27753】Re:ComboBoxの並び替え
発言  m2m10  - 05/8/18(木) 8:17 -

引用なし
パスワード
   長いので、最後まで見ていませんが

 Excelはコンボボックスのソートが有りませんので

 一度、シートに貼り付けをし、並び替えのあと、

 コンボボックスに入れたほうが楽かも。

 

【27754】Re:ComboBoxの並び替え
発言  だるま WEB  - 05/8/18(木) 9:17 -

引用なし
パスワード
   こんにちは

質問内容を拝見すると私のフリーソフトがかなり参考になるのではないかと思いました。

ソート関数 for ExcelVBA
http://www.vector.co.jp/soft/win95/business/se348199.html

この中にサンプルプログラムとして「階層コンボボックス.xls」というのを添付して
います。
コードは公開していますので一部の変更で応用が出来るかもしれません。

直接の回答でなくてごめんなさい。^d^

【27761】Re:ComboBoxの並び替え
お礼  ohana  - 05/8/18(木) 15:42 -

引用なし
パスワード
   ▼m2m10 さん:
>長いので、最後まで見ていませんが
>
> Excelはコンボボックスのソートが有りませんので
>
> 一度、シートに貼り付けをし、並び替えのあと、
>
> コンボボックスに入れたほうが楽かも。
>
> 
助言ありがとうございます(^^)
作業用シートなぞ作ってみます。
ありがとうございました__

【27762】Re:ComboBoxの並び替え
お礼  ohana  - 05/8/18(木) 15:44 -

引用なし
パスワード
   ▼だるま さん:
>こんにちは
>
>質問内容を拝見すると私のフリーソフトがかなり参考になるのではないかと思いました。
>
>ソート関数 for ExcelVBA
>http://www.vector.co.jp/soft/win95/business/se348199.html
>
>この中にサンプルプログラムとして「階層コンボボックス.xls」というのを添付して
>います。
>コードは公開していますので一部の変更で応用が出来るかもしれません。
>
>直接の回答でなくてごめんなさい。^d^

ありがとうございます。
分析させてもらいますm__m

9373 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free