excel vba リストアップ？

質問

超初心者です。
テキストファイルからEXCELへデータを取り込み、ある列のデータより項目を抽出し、コンボボックスへリストアップしたいです。

　A列
1.りんご　　　　　コンボボックス内に
1.りんご　　　　　　1.りんご
1.りんご　　　　　　2.みかん
2.みかん　　　→　　5.なし　　
2.みかん　　　　　　10.ぶどう
5.なし　　　　　　　　と表示させたい
10.ぶどう
10.ぶどう
　・
　・
なお、A列のデータは毎回変動します。
A列のデータには頭に数字がついており、事前に昇順で並べ替えて
あります。

現在、ループを使い、１列ごとに抽出していますが
動作時間の短縮を図りたくて修正しているところです。
ループを使わず、一度に処理できる方法があれば教えてください。

説明がわかりづらいときはすみません。。。

回答No.3

KenKen_SP · ベストアンサー

こんにちは。

データ件数によると思いますが、件数は多いのですか？

ポイントは、データの集合からいかに効率的にユニークな値を取り
出すか....ですよね。

Dictionary オブジェクトが良いかなと思います。ご参考までに。

　　Dim dic　　 As Object ' // Dictionary
　　Dim rSource As Range
　　Dim v　　　 As Variant
　　Dim sKey　　As String

　　' // データ範囲定義
　　Set rSource = Range("A1:A5000")

　　' // Dictionary オブジェクトを使ってユニーク値を取り出す
　　Set dic = CreateObject("Scripting.Dictionary")
　　For Each v In rSource.Value
　　　　sKey = CStr(v)
　　　　If Len(sKey) Then
　　　　　　If Not dic.Exists(sKey) Then
　　　　　　　　dic.Add Key:=sKey, Item:=vbEmpty
　　　　　　End If
　　　　End If
　　Next
　　' // List で一括してアイテムをセットする
　　Me.ComboBox1.List = dic.Keys

　　Set dic = Nothing
　　Set rSource = Nothing

VBA でユニーク値を取り出す方法には、

　　・Dictionary オブジェクト
　　・Collection オブジェクト
　　・ピボットテーブル
　　・フィルタオプション
　　・データベース　DISTINCT 句

などがありますが、Dictionary は扱いが簡単で便利なうえ、割と高速
です。いろいろ調べてみて下さい。

お礼

ご返答ありがとうございました！！
大変勉強になります！！！
早速取り入れさせていただきたいと思います♪

回答No.5

mitarashi

興味の赴くままに調べて回答しておりますので、ご参考にならないかもしれませんが、ご質問の内容から「超初心者」とは思えませんので、Accessにさわった事がおありなら、お役に立つかもしれません。
テキストファイルは実際にはもっと複雑と推察しますので、それに合わせてschema.iniを変更する必要がありますが、参考URLのページのかなり下の方に解説がありますので、ご覧下さい。
'Book3.txtは、列見出しを含まない（データのみ）
'マクロを実行するブックと同じフォルダーに置く
'1.りんご
'1.りんご
'1.りんご
'2.みかん
'....

'schema.ini　の内容
'マクロを実行するブックと同じフォルダーに置く
'[Book3.txt]
'ColNameHeader = False
'CharacterSet = ANSI
'Format = TabDelimited
'Col1=field1 Text Width 20
'
Sub test()
Dim myCon As Object
Dim myRS As Object
Dim myFolder As String
Dim myTxtFile As String
Dim mySQL As String

ActiveSheet.ComboBox1.Clear
Set myCon = CreateObject("ADODB.Connection")
Set myRS = CreateObject("ADODB.Recordset")
myFolder = ThisWorkbook.Path
myTxtFile = "Book3.txt"
mySQL = "SELECT DISTINCT [field1] FROM " & myTxtFile & ";"
With myCon
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Extended Properties") = "TEXT"
.Open myFolder
End With
myRS.Open mySQL, myCon
Do While Not myRS.EOF
ActiveSheet.ComboBox1.AddItem myRS.Fields(0)
myRS.MoveNext
Loop
myRS.Close
Set myRS = Nothing
myCon.Close
Set myCon = Nothing
End Sub
自分の持っている参考書には、テキストファイルから読込時のSQLの使用の言及はありませんでしたが、色々調べてやってみると、可能でした。スピードの方はご期待に添えるかどうかは不明です。

参考URL：

http://makotowatana.ld.infoseek.co.jp/access/dahowchangingtext.htm#start

お礼

ご返答ありがとうございました！！
説明不足でしたが、今回こうやって質問させていただいたのは
前任者が作ったマクロを、さらに効率良く、見やすいマクロに
修正する任務に就いたからでありまして・・。
『動作スピードのアップ＋解りやすいマクロ』作りを
しなければいけませんので・・・。
でも、私の今後の仕事にぜひ活かしていきたいと思いますので
mitarashiさんに回答していただいた事は、これから勉強して
いきますね！
貴重なお時間を割いてご返答いただき感謝しております。

回答No.4

imogasi

たまたまＡ列の前に数字が入っていて.が入っているらしいので、数字を分離する。
空き列に（またはＢ列に列挿入）
=LEFT(A1,FIND(".",A1)-1)*1
と入れて下方向に式を複写。
例データ
1.りんご 1
1.りんご 1
1.りんご 1
2.みかん 2
2.みかん 2
5.なし 5
10.ぶどう 10
10.ぶどう 10
ーーＳｈｅｅｔ１上にコンボボックス（コントロールツールボックスの）を１つ貼り付け。
ーー
Sub test01()
m = Application.WorksheetFunction.Max(Range("B1:B1000"))
Range("b1").Activate
For i = 1 To m
Set a = Range("B1:B1000").Find(What:=i, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If a Is Nothing Then
Else
MsgBox a.Offset(0, -1)
Worksheets("Sheet1").ComboBox1.AddItem a.Offset(0, -1)
End If

Next i
End Sub
を実行
ーー
結果
コンボボックスcomboBox1のアイテムに
1.りんご
2.みかん
5.なし
10.ぶどう
だ出た。
まあ質問者が注文をつけているループを使わず（初心者はこういうことに過度にこだわらないほうがよいと思う）、は、Ｆｏｒ　Ｎｅｘｔでループしてるともいえるが、Ｆｉｎｄメソッドを使ってランダム検索発見しているので、許して。処理時間も１０００行ぐらいでたいしたこと無いと思う。しかしコンボに沢山アイテムが出るのは実用的でないと思う。
ーー
関数ナリを活用してＶＢＡコードを簡単(少ない行数）にすることを、回答で私は考えている。

お礼

ご返答ありがとうございます！！
いろいろな方法があるのですね。
勉強させていただきます★

回答No.2

siroakaki

A列データでピボットテーブルを作って、その結果をコンボボックスに表示させては、いかがでしょう？

お礼

ご返答ありがとうございました！！
ピポットテーブルですね。
コンボボックスにデータを取り込むだけの為にピポットテーブルを使うのって、時間の短縮になりそうですか？
これについては少し勉強してみます！
貴重なご意見ありがとうございました。

回答No.1

kenpon24

ループは使いますけど、一度データをメモリに入れてから
重複しないデータをAddItemするってのではダメですか？
毎回セルにアクセスするよりは相当早いはずですけど。

Sub てすと()
Dim Datas As Variant
Dim Temp As String
Dim bottom As Long
Dim Row As Long

'最終行を取得
bottom = Range("A65536").End(xlUp).Row

'variant変数にデータ配列を入れる
Datas = Range("A1:A" & bottom)

With UserForm1
If bottom = 1 Then
.ComboBox1.AddItem Datas
Else
For Row = 1 To bottom
'一度だけ登録する
If Datas(Row, 1) <> Temp Then
.ComboBox1.AddItem Datas(Row, 1)
Temp = Datas(Row, 1)
End If
Next Row
End If
'表示
.Show
End With

End Sub

お礼

ご返答ありがとうございました！！
セルを一つ一つ検証していくのではなく、一気にデータを取り込んで
変数内で検索（？）していくんですね。
なるほど。
早速試させていただこうと思います。