[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『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 >
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
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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.