Excel VBA質問箱 IV

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

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


8277 / 13646 ツリー ←次へ | 前へ→

【34231】コンボボックスで重複読込をしないようにする かとぼん 06/1/29(日) 11:31 質問[未読]
【34232】Re:コンボボックスで重複読込をしないよう... かみちゃん 06/1/29(日) 11:39 発言[未読]
【34256】ありがとうございました。 かとぼん 06/1/29(日) 20:45 お礼[未読]
【34242】Re:コンボボックスで重複読込をしないよう... Hirofumi 06/1/29(日) 17:42 回答[未読]
【34254】ありがとうございました。 かとぼん 06/1/29(日) 20:44 お礼[未読]

【34231】コンボボックスで重複読込をしないように...
質問  かとぼん E-MAIL  - 06/1/29(日) 11:31 -

引用なし
パスワード
   みなさん、こんにちは。少し分からないところがあるので、どなたかご教授下さい

   A
3  ぞう
4  きりん
5  パンダ
6  ぞう
7  ライオン
8  ライオン
9  ねこ
.   .
.   .
.   .

というシートがあってA列の値をコンボボックスに読み込んでユーザーに選択させます。新しい動物を書く場合はコンボボックスに書かせてA列に登録します。
参照としてA列をコンボボックスに読み込ませていますが、上のそのままを
読み込んでしまいますので、ぞう・ライオンが2回出てきます。
私がしたいのは上の列をコンボボックスに読み込ませて、重複は省き、
ぞう・きりん・パンダ・ライオン・ねこ とコンボボックスに読み込ませたい
のですが、どうしたらいいでしょうか?

以下コードを記述します。

Private Sub UserForm_Initialize()


Dim dcunt As Integer
Dim drnge As Range
Dim rsoc As String

Set drnge = Sheet2.Range("A3").CurrentRegion
   dcunt = drnge.Rows(drnge.Rows.Count).Row
   rsoc = "アドレス帳!A3:A" & dcunt
   Combo業種.RowSource = rsoc
  
  
End Sub

Private Sub CommandOK_Click()


If Combo業種.Value = "" Then
  MsgBox "業種を選ぶか、新規の場合は記入して下さい"
  Exit Sub
  Else:
  
  Sheet2.Select
  
  Range("A3").Value = Combo業種.Value
  Unload Me
  
  Sheet1.Select
 
End If

End Sub

【34232】Re:コンボボックスで重複読込をしないよ...
発言  かみちゃん  - 06/1/29(日) 11:39 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>上の列をコンボボックスに読み込ませて、重複は省き、
>ぞう・きりん・パンダ・ライオン・ねこ とコンボボックスに読み込ませたい

「フィルタオプションの設定」を使うと、「重複しないデータ」を抽出すること
ができますので、その結果をコンボボックスのリストに追加(RowSourceを使わない)
することではいけませんか?
[#15506][#31378]からのスレッドが参考になるかと思います。

【34242】Re:コンボボックスで重複読込をしないよ...
回答  Hirofumi  - 06/1/29(日) 17:42 -

引用なし
パスワード
   業種が100や200ならこんな程度でも善いかも?

Option Explicit

'ComboBoxのデータの有るシート名を設定
Private Const cstrSheet As String = "アドレス帳"
'ComboBoxのデータの始まりのセル位置を設定
Private Const cstrTop As String = "A3"

Private Sub UserForm_Initialize()

  Dim vntList As Variant
  
  '重複取り
  vntList = GetCombList(cstrSheet, cstrTop)
  '戻り値が配列なら
  If IsArray(vntList) Then
    'ComboBoxのListに登録
    ComboBox1.List = GetCombList(cstrSheet, cstrTop)
  End If
  
End Sub

Private Function GetCombList(strSheet As String, strTop As String) As Variant

  Dim i As Long
  Dim j As Long
  Dim lngPos As Long
  Dim lngRows As Long
  Dim vntData As Variant
  Dim vntResult As Variant
  
  With Worksheets(strSheet).Range(strTop)
    '行数を取得
    .Offset(65536 - .Row).End(xlUp).Select
    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
    If lngRows <= 1 And .Value = "" Then
      Exit Function
    End If
    'データを取得
    vntData = .Resize(lngRows + 1).Value
  End With
  
  '結果配列の初期の大きさを設定
  ReDim vntResult(lngPos)
  '結果配列に1行目を代入
  vntResult(lngPos) = vntData(1, 1)
  'データの最後まで繰り返し
  For i = 2 To lngRows
    '結果配列に同じ値が有るか確認
    For j = 0 To lngPos
      '同じ値が有る場合Forを抜ける
      If vntResult(j) = vntData(i, 1) Then
        Exit For
      End If
    Next j
    '同じ値が無い場合
    If j > lngPos Then
      '結果配列の最大添え字を更新
      lngPos = j
      '結果配列を拡張
      ReDim Preserve vntResult(lngPos)
      '結果配列に登録
      vntResult(lngPos) = vntData(i, 1)
    End If
  Next i
  
  GetCombList = vntResult
  
End Function

【34254】ありがとうございました。
お礼  かとぼん E-MAIL  - 06/1/29(日) 20:44 -

引用なし
パスワード
   うまくいくことができました。
ありがとうございます。

【34256】ありがとうございました。
お礼  かとぼん E-MAIL  - 06/1/29(日) 20:45 -

引用なし
パスワード
   一応質問する前に検索したつもりでしたが、
いろいろ参考になりました。
ありがとうございました。

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