[[20170215170852]] 『csvファイルを取込複数の参照一致で複数のデータax(tamasuke) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『csvファイルを取込複数の参照一致で複数のデータを取り込む方法』(tamasuke)

初めまして
エクセルのことで質問があります
エクセルデータのA列に番号 B列に製品名 C列に金額
の記入されたエクセルデータがあるとします
別ファイルのCSVに上記と同じ内容プラス
D列に在庫数 E列に管理場所 が記載されているものとします
エクセルデータのA列 B列 C列、CSVののA列 B列 C列が一致した場合
エクセルデータのD列 E列にCSVのD列 E列を挿入したいのです
エクセル関数のVLOOKUPを使えば簡単なのですが
エクセルデータの件数が5万件、CSVの件数が7千件と
とんでもない件数なので関数ではエクセルがフリーズしたようになります
何とか、早く処理をする方法はないでしょうか?
重複(A列 B列 C列すべてが)件数はないものと考えています
(重複が見つかったらその箇所がわかるとベストではありますが、、)
よろしくお願いします

< 使用 Excel:Excel2013、使用 OS:Windows7 >


5万件でも使えるかどうかは試してみて欲しいですが、Dictionaryオブジェクトで処理する例なぞ。
CSVファイルは、カンマ区切りで、改行コードはCRLFと仮定してます。
もしシート側に重複があった場合は、エラー表示して処理を中断するようにしました。

 Sub test()
    Dim DIC As Object
    Dim F1 As Integer
    Dim i As Long
    Dim cw As String
    Dim vw As Variant

    Set DIC = CreateObject("Scripting.Dictionary")

    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        cw = Cells(i, "A").Value & "|" & Cells(i, "B").Value & "|" & Cells(i, "C").Value
        If DIC.Exists(cw) = False Then
            DIC.Add cw, i
        Else
            MsgBox i & "行目 " & cw & "は重複", vbCritical, "エラー"
            Exit Sub
        End If
    Next i

    Application.ScreenUpdating = False

    F1 = FreeFile
    Open "C:\tmp\test.csv" For Input As #F1
    Line Input #F1, cw
    While EOF(F1) = False
        Line Input #F1, cw
        vw = Split(cw, ",")
        cw = vw(0) & "|" & vw(1) & "|" & vw(2)
        If DIC.Exists(cw) = True Then
            Cells(DIC(cw), "D").Value = vw(3)
            Cells(DIC(cw), "E").Value = vw(4)
        End If
    Wend
    Close #F1

    Application.ScreenUpdating = True
    MsgBox "処理終了", vbInformation, "終了"
 End Sub
(???) 2017/02/15(水) 18:00

あと、CSVのデータと一致するものがシートに無かった場合を想定していません。
もし、一致が無かった場合は1行追記が必要でしたら、If DIC.Exists(cw) = True Then に対する Else 時の処理を追加してください。
(???) 2017/02/15(水) 18:03

???さん
VBAの作成ありがとうございました
検証した結果、CSVの中に,が複数存在し、その結果、
参照対象がずれてしまいうまく機能しませんでした
,区切りで、ずれてしまうのを治す方法はありませんか?
CSVではなくエクセルデータの取込でもOKですのでお教えください
CSVを変数に取り込む部分をエクセルデータに置き換える
方法をいろいろ考えてみたのですが、VBAの知識のない当方には荷が重すぎました
なにとぞよろしくお願いします
(tamasuke) 2017/02/16(木) 15:43

変数ではなく配列でしょうか?
すみませんその辺の違いも怪しいです
よろしくお願いいたします
(tamasuke) 2017/02/16(木) 15:46

改行があるとなると、シーケンシャルファイル読込案は使えませんね。ファイル読込方法を変えた、以下で試してみてください。
(ファイル名部分とシート名部分は、現状に合わせて変更してください)

 Sub test()
    Dim DIC As Object
    Dim wk1 As Worksheet
    Dim i As Long
    Dim cw As String

    Set wk1 = Sheets("Sheet1")
    Set DIC = CreateObject("Scripting.Dictionary")

    With wk1
        For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
            cw = .Cells(i, "A").Value & "|" & .Cells(i, "B").Value & "|" & .Cells(i, "C").Value
            If DIC.Exists(cw) = False Then
                DIC.Add cw, i
            Else
                MsgBox i & "行目 " & cw & "は重複", vbCritical, "エラー"
                Exit Sub
            End If
        Next i
    End With

    Application.ScreenUpdating = False

    With Workbooks.Open("C:\tmp\test.csv", False, True)
        With Sheets(1)
            For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
                cw = .Cells(i, "A").Value & "|" & .Cells(i, "B").Value & "|" & .Cells(i, "C").Value
                If DIC.Exists(cw) = True Then
                    wk1.Cells(DIC(cw), "D").Value = .Cells(i, "D").Value
                    wk1.Cells(DIC(cw), "E").Value = .Cells(i, "E").Value
                End If
            Next i
        End With
        .Close False
    End With

    Application.ScreenUpdating = True
    MsgBox "処理終了", vbInformation, "終了"
 End Sub
(???) 2017/02/16(木) 16:25

???さん
コメント遅くなり申し訳ありませんでした
読み込みファイルをCSVからXLSXに変更することにより機能いたしました
取込データに001というように0から始まるデータが多数存在しCSVでは0が消えてしまうので
取込ができませんでした
あと、もとデータファイルに「#N/A」のエラーコードが入っているセルがあり、
そこでVBAが止まってしまいますが、「#N/A」を削除することで非常に高速に処理することができました
いま、テストファイルにて取込適用先ファイル44000件、取込ファイル130件で実行してみましたが
2秒ほどで完了しています
本当にありがとうございました
感謝です!!
(tamasuke) 2017/02/22(水) 11:58

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.