完成イメージ：主な流れ
- マクロを実行すると、「注文」CSVを選ぶダイアログが出る → 選択
- マクロが「注文」CSVを開き、Sheet1のA2セルから下へ連続で貼り付ける
- 続いて「品名」CSVを選ぶダイアログが出る → 選択
- マクロが「品名」CSVを読み込み、B,C,D列をキー(連結文字列など)として「パターン」列の値をメモリに保持
- 先ほど取り込んだ「注文」データの各行(B列,C列,D列)をキーに照合し、一致するものがあれば**E列に「パターン」**を書き込む
「注文」CSVのパスをファイルダイアログで取得し、Sheet1へ貼り付け
Option Explicit
Sub ImportTwoCSVs()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") ' 取り込み先をSheet1とする
'======================================================
' [1] 「注文」CSVのパスをファイルダイアログで取得し、Sheet1へ貼り付け
'======================================================
Dim orderCsvPath As Variant
orderCsvPath = Application.GetOpenFilename( _
FileFilter:="CSVファイル (*.csv), *.csv", _
Title:="【注文CSV】を選択してください")
If orderCsvPath = False Then
MsgBox "処理をキャンセルしました(注文CSV未選択)。"
Exit Sub
End If
' 注文CSVをSheet1のA2セルから展開
Dim lastRowOrder As Long
lastRowOrder = ImportCsvToSheet(ws, orderCsvPath, 2, 1)
' ※戻り値：貼り付けた最終行(row)を返している
If lastRowOrder < 2 Then
MsgBox "注文CSVの取り込みができなかったようです。処理を終了します。"
Exit Sub
End If
MsgBox "「注文」CSVをA2から取り込み完了。最終行：" & lastRowOrder, vbInformation
「品名」CSVを読み込み、「パターン」だけを辞書化して保持
※キーは B,C,D列の連結文字列とする
Dim itemCsvPath As Variant
itemCsvPath = Application.GetOpenFilename( _
FileFilter:="CSVファイル (*.csv), *.csv", _
Title:="【品名CSV】を選択してください")
If itemCsvPath = False Then
MsgBox "処理をキャンセルしました(品名CSV未選択)。"
Exit Sub
End If
' 品名CSVを1行ずつ読んで、(B列,C列,D列)→パターン の対応をDictionaryに格納
Dim dictPattern As Object
Set dictPattern = CreateObject("Scripting.Dictionary")
dictPattern.CompareMode = vbTextCompare ' 大文字小文字を区別しない(必要に応じて)
Dim ff As Integer
ff = FreeFile
Open CStr(itemCsvPath) For Input As #ff
Dim lineTxt As String
Dim cols() As String
Do Until EOF(ff)
Line Input #ff, lineTxt
cols = Split(lineTxt, ",") ' カンマ区切りで分割
' 必要な列数が足りない行は無視（例：最低でもD列(Index=3)まである前提）
If UBound(cols) >= 3 Then
' B列=cols(1), C列=cols(2), D列=cols(3) をキーとし、パターン列を取得
' 例：パターン列が "品名" CSVの5列目(Index=4)にあるなら
' cols(4) が "パターン" 値に該当
' あるいはヘッダ付きCSVの場合は、最初の行はスキップなど調整してください
Dim keyStr As String
keyStr = cols(1) & "_" & cols(2) & "_" & cols(3) ' B,C,Dを連結
Dim patternVal As String
If UBound(cols) >= 4 Then
patternVal = cols(4) ' 5列目(Index=4)がパターン
Else
patternVal = "" ' パターン列が無い or 足りない場合は空
End If
If Not dictPattern.Exists(keyStr) Then
dictPattern.Add keyStr, patternVal
End If
End If
Loop
Close #ff
MsgBox "「品名」CSVを読み込み、パターン辞書を作成しました。" & vbCrLf & _
"(登録件数: " & dictPattern.Count & ")", vbInformation
Sheet1 上に取り込んだ「注文」データの各行(B,C,D列)でキーを作りE列に書き込む
※辞書を参照
Dim r As Long
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' A列最終行(注文CSV取込部分)を想定
For r = 2 To lastRow
Dim bVal As String: bVal = CStr(ws.Cells(r, 2).Value) ' B列
Dim cVal As String: cVal = CStr(ws.Cells(r, 3).Value) ' C列
Dim dVal As String: dVal = CStr(ws.Cells(r, 4).Value) ' D列
Dim keyCheck As String
keyCheck = bVal & "_" & cVal & "_" & dVal ' B,C,D連結
If dictPattern.Exists(keyCheck) Then
ws.Cells(r, 5).Value = dictPattern(keyCheck) ' E列にパターンを書き込み
Else
' 見つからない場合は空欄にする or 何もしない等お好みで
' ws.Cells(r, 5).Value = ""
End If
Next r
MsgBox "すべての処理が完了しました。", vbInformation
End Sub
【共通関数】: 指定したCSVを1行ずつ読み込み、Sheetへ貼り付ける
ws: 転記先シート
csvPath: CSVのフルパス
startRow, startCol: 貼り付け開始セル(行,列)
戻り値: 貼り付けした最後の行番号（データが無ければ startRow – 1）
Public Function ImportCsvToSheet(ws As Worksheet, _
ByVal csvPath As String, _
ByVal startRow As Long, _
ByVal startCol As Long) As Long
Dim fNum As Integer
Dim lineTxt As String
Dim spl() As String
Dim r As Long
fNum = FreeFile
Open csvPath For Input As #fNum
r = startRow
Do Until EOF(fNum)
Line Input #fNum, lineTxt
spl = Split(lineTxt, ",")
Dim i As Long
For i = LBound(spl) To UBound(spl)
ws.Cells(r, startCol + i).Value = spl(i)
Next i
r = r + 1
Loop
Close #fNum
' 最後に書き込んだ行 = r - 1
ImportCsvToSheet = r - 1
End Function
コード解説
ImportTwoCSVsマクロGetOpenFilenameによりユーザーに「注文」CSVを選んでもらい、そのパス(orderCsvPath)を取得。ImportCsvToSheet関数を使って、Sheet1のA2セル(2行目,1列目) から貼り付ける（全面ペースト）。- 貼り付け終わった最終行を戻り値で受け取る（
lastRowOrder）
- 貼り付け終わった最終行を戻り値で受け取る（
- 続いて「品名」CSVも同様にファイルダイアログで選択 → Pathを取得。
- 「品名」CSVを行単位で読み込み、B列=cols(1), C列=cols(2), D列=cols(3) を文字列連結したものをキーに、パターン列=cols(4) を値にして
dictPattern（Dictionary）へ格納。- CSVがヘッダ付きの場合などは、最初の1行をスキップする処理を入れるなど、適宜修正して下さい。
- 「品名」CSVの列構成が違う場合は、
cols(1),cols(2),cols(3),cols(4)の部分を書き換えてください。
- Sheet1に取り込まれた「注文」データの各行(2行目〜最終行)について、B,C,D列の値を連結したキーで
dictPatternを検索し、一致すればE列へ「パターン」を書き込み。
ImportCsvToSheet関数- CSVを行単位で読み出し(
Line Input)、カンマ区切り(Split)したデータをシートへ横に貼り付けるだけの簡易関数。 - 書き込んだ最後の行番号を返します。
- CSVを行単位で読み出し(
カスタマイズのポイント
- CSVヘッダ行がある場合
- 「1行目はヘッダで、実データは2行目から」などの場合は、最初の
Line Inputを読み飛ばす実装を入れるか、必要に応じてヘッダ行も貼り付けるなど調整してください。
- 「1行目はヘッダで、実データは2行目から」などの場合は、最初の
- 「品名」CSVのB,C,D 列や「パターン」列の位置が違う場合
- たとえばB,C,Dが0-basedで
cols(3), cols(4), cols(5)などになっている場合や、「パターン」がcols(7)にある場合など、dictPatternに格納するときのインデックスを修正してください。
- たとえばB,C,Dが0-basedで
- 「パターン」を書き込む列を変えたい場合
- 上記例ではE列(列番号5)に書いています。別の場所にしたければ
ws.Cells(r, 5)を変更してください。
- 上記例ではE列(列番号5)に書いています。別の場所にしたければ
- 見つからない場合の挙動
- キーが一致しないときに「#N/A」等を入れる、あるいは空白のままにするなど、お好みに合わせて変更可能です。
- 複数のシートに分けて取り込みたい
Worksheets("Sheet2")のように変更して複数回呼び出すことで、任意のシートへ張り付けられます。
- 同じフォルダから自動で2つのCSVを読む場合
Application.GetOpenFilenameで1つめのCSVを取得し、そのパスからフォルダを切り出して、2つめはファイル名のみ指定するといった応用も可能です。
以上のように「注文CSVをまずExcelに取り込み → 品名CSVを辞書化してパターン列だけ追加書き込み」という処理を一括で行うことができます。
実際にはCSVの列構成やヘッダの有無などによって読み取りインデックスを微調整する必要がありますが、根本的な考え方は
- CSVをシートに貼り付ける
- 別のCSVを読み込んでDictionaryなどで持つ
- シート上のキー列(B,C,D)で照合し、必要項目(パターン)を貼り付ける
…という流れになります。ぜひご希望に合わせてカスタマイズしてください。
1行目はヘッダ行、2行目以降が実データ」という場合
CSVの「1行目はヘッダ行、2行目以降が実データ」という場合、最初の1行を読み飛ばすロジックを追加すればOKです。たとえば下記のサンプルでは、Line Input #fileNo, textLine を1回だけ実行して何もせずに破棄してしまい、その後のループで実データのみを処理しています。
Sub ImportCsv_SkipHeader()
Dim csvFilePath As String
csvFilePath = "C:\temp\sample.csv" ' CSVファイルのパスを設定してください
Dim fileNo As Integer
Dim textLine As String
Dim spl() As String
fileNo = FreeFile
Open csvFilePath For Input As #fileNo
' ---- [1行目(ヘッダ)を読み飛ばす] ----
If Not EOF(fileNo) Then
Line Input #fileNo, textLine ' ←この読み込みで1行目を破棄
End If
' ---- [2行目以降(実データ)を読み込む] ----
Do Until EOF(fileNo)
Line Input #fileNo, textLine
spl = Split(textLine, ",")
' 実データに対する処理をここに記述
' 例：シートに書き込むなど
' For i = LBound(spl) To UBound(spl)
' Cells(rowCount, colCount + i).Value = spl(i)
' Next i
Loop
Close #fileNo
End Sub
コメント