VBA（多くの数値データの最小値５つを格納する方法）

質問

VBA（多くの数値データの最小値５つを格納する方法）

現在テキストファイルの数値データを取り出し最小値５つを書き出す動作をVBAで行うつもりでいます。

例　　5
　　　9
　　　33
　　　11
　　　1
　　　0.3
　　　0.02
　　　　・
　　　　・
　　　　・
　　　　・

といった形の数値データ行がテキストファイルに存在します。
今現在すべての数値データを格納してエクセルに書き出しそれを並び替え最小値5つ（0を除く）を見て作業を行っております。

この作業をより効率化するために、VBAを用いて0を除いた最小値5つをエクセルシートに書き出すようにしたいのですが、VBAの知識が足らず対策が思い浮かびません。

・VBAで行いたいこと（わからない部分）
格納するデータを５つに設定して、数値データを順次読み込み最終的に数値データ群の最小値５つ（０を除く）を配列に格納している状態にしたい。

初歩的かもしれませんが、ご回答お願いいたします。

回答No.4

rukuku

こんばんは

＞今現在すべての数値データを格納してエクセルに書き出しそれを並び替え最小値5つ（0を除く）を見て作業を行っております。
＞この作業をより効率化するために、VBAを用いて0を除いた最小値5つをエクセルシートに書き出すようにしたいのですが、VBAの知識が足らず対策が思い浮かびません。

Excel自身が優れた能力を持っているので、VBAでもExcelの力を借りることをお勧めします。
以下のマクロはご質問の手順に近い形で組んであります。
元のデータは、
１．マクロのあるエクセルファイルと同じフォルダにある（サブフォルダでは×）
２．元データはテキスト形式で、ファイル名が「元データ.txt」
であると想定しています。

Sub　抽出()
　　'準備
　　ThisWorkbook.Activate
　　Worksheets(1).Select
　　Cells.Delete
　　[A1].Select

　　'コピー
　　Workbooks.Open　ThisWorkbook.Path　&　"\元データ.txt",　ReadOnly:=True　'元データを開く
　　[A:A].Replace　What:="0",　Replacement:="",　LookAt:=xlWhole　'ゼロを除去
　　[A:A].Sort　Key1:=Range("A1"),　Order1:=xlAscending,　Header:=xlNo　'昇順で並べ替え
　　[A1:A5].Copy　'クリップボードにコピー

　　'ペースト
　　ThisWorkbook.Activate
　　ActiveSheet.Paste

End　Sub

回答No.3

mitarashi

こんな方法もあります。ご参考まで。
対象のテキストファイルを、C:\text.txt とします。
テキストファイルの構造が分かりませんが、最初のフィールドが対象データだとします。
Sub test()
Dim CN As Object
Dim RS As Object
Dim mySQL As String

Set CN = CreateObject("ADODB.Connection")
CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\;" & _
"Extended Properties='Text;HDR=NO'"
mySQL = "SELECT TOP 5 mytable.F1 FROM test.txt as mytable WHERE mytable.F1<>0 ORDER BY mytable.F1;"
Set RS = CN.Execute(mySQL)
With ActiveSheet
.Range("A1").CopyFromRecordset RS
End With
Set RS = Nothing
Set CN = Nothing
End Sub

参考URL：

http://home.att.ne.jp/zeta/gen/excel/c04p47.htm

回答No.2

imogasi

最小や最大の問題は、どんな優れたアルゴリズムでも、データを最後まで１回は読まないとなりません。
それ以上のアルゴリズムはありません。
（１）小さいものから順（昇順）にソートをして、最後データを加えてソートして（ソートが終わって）、最も小さいもの（先頭）から５つ採る。
（２）５つのデータを保存する変数をもうけ、変数に１－５までの大小順序を固定して考え、（１つ前までのデータでの１番席から５番席）データを１つ読んだとき、何番席に座るべきかチェックする。直前の小さいものからの５番よりも大きい場合は捨てる。1番から５番までの間に入る場合は、それ以下をずらし（今の５番目は捨てて）いく。
この方式で最終データを処理し終わると、５つの席（変数）に望みの数が残る。
最小値を１つ求めるアルゴリズム（やったことありますか）の小さい方から５つ版です。
ソートプログラムがレディメードである場合（エクセルのシートデータのソートや、オフコン・大型コンピュタでのソート・マージユティティ）はそれを使うと確実でかつ速い（アルゴリズムに、完了を早くする様々なプロの工夫があるようだから）。
ソートプログラムを自作しないとならない状態なら、（２）の方が良いかも。ソートプログラムの自作は、アルゴリズムによってはプログラムが初心者には難しいと思うし、多様なデータでのテストが難しく、テスト不足でプログラムエラーがデバッグできてないことも起こりえる。
業務データなどで自作の結果にエラーが発見されると、大責任問題になりかねない。恐ろしいことです。

回答No.1

jcctaira

一応以下の処理でMinDataに最小値を求めることができると思います。
※ファイルのフルパス名は修正してください。

Sub 最小値を求める()
　Const 取得件数 = 5
　Dim I　　　　　　　　　　　 As Integer
　Dim InData　　　　　　　　　As Double
　Dim MinData(1 To 取得件数)　As Double
　Open "D:\TESTDATA.txt" For Input As #1
　Do While Not (EOF(1))
　　Input #1, InData
　　Select Case True
　　　Case InData = 0
　　　Case WorksheetFunction.Min(MinData) = 0
　　　　For I = 1 To 取得件数
　　　　　If MinData(I) = 0 Then
　　　　　　MinData(I) = InData
　　　　　　Exit For
　　　　　End If
　　　　Next I
　　　Case WorksheetFunction.Max(MinData) > InData
　　　　For I = 1 To 取得件数
　　　　　If MinData(I) = WorksheetFunction.Max(MinData) Then
　　　　　　MinData(I) = InData
　　　　　　Exit For
　　　　　End If
　　　　Next I
　　End Select
　Loop
　Close
End Sub