| |
こんにちわ。おじゃまします。
すみませんが、教えていただけないでしょうか・・・。
１．複数のシートから呼び出したコンボボックスの全リストの並び替え
２．どのコンボボックスから入力しても反応してほしい
ということなのですが。
メーカー名（ComboBox4)・商品名(Combobox5)・規格(ComboBox6)・入数(textBox2)etc・・・ の情報が入ったシートが複数あります。(増える可能性大）
その複数のシートから重複しないﾘｽﾄをComboboxにListを表示させています。
1文字目を入れて、Enterを押すとその文字の１番目が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
長くて、わかりずらい文章ですみません。
どうか助言をよろしくお願いします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 05/8/18(木) 9:17 -
