個人事業主の方必見!確定申告のお悩み解決

エクセルのマクロを使用して以下のことを行いたいです。
(※VBA初心者なので解説を書いていただけるとありがたいです。)

・商品マスタのCSVを読み込む。
 30万件以上あるので、エクセルでは表示できません。

・読み込んだ商品マスタに記載されている商品コードを、
 商品データ一覧のエクセルファイルに自動で転記したい。
 
 商品データ一覧のエクセルファイルには、「商品番号」「色」「サイズ」があります。
 この3条件が商品マスタのものと一致する商品マスタのコードを転記したいです。


量が膨大なうえ、急ぎの作業なため、何卒よろしくお願いいたします。

このQ&Aに関連する最新のQ&A

A 回答 (1件)

>量が膨大なうえ、急ぎの作業なため、


そういう事なら、エクセル2010を買ってきてフィルタオプションでやるか、アクセスでやる事をお勧めします。

2003以前でやるのは、VBA初心者の方には荷が重いと思います。テキストファイルを読みこんで順次照合する様な方法では、原理的には出来ても遅くてやっていられないと予想します。ADOを用いて、テキストファイルから抽出する方法を下記で回答しています。
http://okwave.jp/qa/q7205971.html
#5で回答している試験データに合わせて、1条件分だけですが試してみました。
ADOや、SQLについて調べまくって応用できる様ならご活用下さい。解説はいたしかねます。

☆SQLで抽出する例

Sub test()
Dim CN As Object
Dim RS As Object
Dim mySQL As String
Dim i As Long, dataCount As Long
Dim sh As Worksheet
Dim wbk As Workbook
Const blockSize As Long = 50000
Const adOpenStatic = 3
Const adLockReadOnly = 1

Set wbk = Workbooks.Add
Set CN = CreateObject("ADODB.Connection")
CN.Provider = "Microsoft.Jet.OLEDB.4.0"
CN.Properties("Extended Properties") = "Text;HDR=NO"
CN.ConnectionString = ThisWorkbook.Path & "\"
CN.Open
Set RS = CreateObject("ADODB.Recordset")
mySQL = "SELECT * FROM sample.csv WHERE (([sample#csv].F1 LIKE 'a%') AND ([sample#csv].F3 = '良品') AND ([sample#csv].F4 > 500));"

RS.Open mySQL, CN, adOpenStatic, adLockReadOnly
dataCount = RS.RecordCount
For i = 1 To Int(dataCount / blockSize) + 1
Set sh = wbk.Worksheets.Add(after:=Worksheets(wbk.Worksheets.Count))
With sh
RS.MoveFirst
RS.Move (blockSize * (i - 1))
.Range("A1").CopyFromRecordset RS, blockSize
End With
Set sh = Nothing
Next i
RS.Close
wbk.SaveAs ThisWorkbook.Path & "\" & "extractSample.xls"
Set RS = Nothing
CN.Close
Set CN = Nothing
End Sub

☆全データをメモリ上に読みこんでFilterで絞り込む例
メモリが足りれば速そうに思えるが、1条件だけでは若干遅く感じた。複数条件調べる場合は、都度メモリに読みこむ必要がないので、逆転するかも。

Sub test2()
Dim CN As Object
Dim RS As Object
Dim mySQL As String
Dim i As Long, dataCount As Long
Dim sh As Worksheet
Dim wbk As Workbook
Const blockSize As Long = 50000
Const adOpenStatic = 3
Const adLockReadOnly = 1

Set wbk = Workbooks.Add
Set CN = CreateObject("ADODB.Connection")
CN.Provider = "Microsoft.Jet.OLEDB.4.0"
CN.Properties("Extended Properties") = "Text;HDR=NO"
CN.ConnectionString = ThisWorkbook.Path & "\"
CN.Open
Set RS = CreateObject("ADODB.Recordset")
mySQL = "SELECT * FROM sample.csv;"

RS.Open mySQL, CN, adOpenStatic, adLockReadOnly
RS.Filter = "(F1 LIKE 'a*') AND (F3 = '良品') AND (F4 > 500)"
dataCount = RS.RecordCount
For i = 1 To Int(dataCount / blockSize) + 1
Set sh = wbk.Worksheets.Add(after:=Worksheets(wbk.Worksheets.Count))
With sh
RS.MoveFirst
RS.Move (blockSize * (i - 1))
.Range("A1").CopyFromRecordset RS, blockSize
End With
Set sh = Nothing
Next i
'RS.Filter = "" 'Filter解除
RS.Close
wbk.SaveAs ThisWorkbook.Path & "\" & "extractSample.xls"
Set RS = Nothing
CN.Close
Set CN = Nothing
End Sub

※ワイルドカードは、ADOのSQLの場合は%のみ、フィルターの場合は%でも*でも良さそうです。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング