拡張CSVに対応した CSV インポート
CSV ファイルを読み込むとき VB.NET であれば TextFieldParser というクラスで簡単に行えるのですが Excel 2003 の VBA には該当クラスは存在しません。自分で CSV を読み込む際に問題になるのが値として含まれるカンマ「,」です。Microsoft では以下のようにダブルクォーテーションで囲うことで、それを表現しています(拡張CSV)。
1,"HERE,THERE AND EVERYWHERE",The Beatles 2,"Walk, Don't Run!",Johnny Smith 3,TARKUS,"Emerson, Lake & Palmer"
このようにすべての項目にダブルクォーテーションがつくとは限らないし、出現位置も同じとは限らないのが特徴です。また、ダブルクォーテーションそのものを値として含む場合には「""」という形で表わすので、これにも考慮しないといけません。
こうした CSV を読み込むために、正規表現と文字列関数を合わせて作った処理が以下。適当なボタンにマクロ登録して使う事を想定しています。
' CSVインポートボタンクリック Sub ImportCsvClick() Const FORM_TITLE = "CSVファイル読み込み処理" Const FORM_FILTER = "CSVファイル (*.csv),*.csv" Dim xlApp As Application ' Application オブジェクト Dim fIndex As Integer ' FreeFile 値 Dim strFile As String ' 入力されるファイル名 Dim recordArray() As Variant ' 読み込んだレコードの配列 Dim rowIndex As Long ' CSV の項目インデックス Dim lineIndex As Long ' レコード件数のインデックス Dim strInput As String ' 読み込まれるレコード行 Dim startIndex As Long ' 行検索開始位置のインデックス Dim destIndex As Long ' 同、終了位置のインデックス Dim objRegex, objMatches As Object ' 正規表現クラスのオブジェクト Dim strPattern As String ' ダブルクォートの正規表現パターン ' Application オブジェクト取得 Set xlApp = Application ' フォームからファイルを受け取る strFile = xlApp.GetOpenFilename(FileFilter:=FORM_FILTER, Title:=FORM_TITLE) ' キャンセルされた場合処理を終了 If StrConv(strFile, vbUpperCase) = "FALSE" Then Exit Sub End If ' CSV データが入力されるシートを選択 Worksheets("シート名指定").Activate ' FreeFile 形式で入力を行う fIndex = FreeFile ' 指定ファイルを開く Open strFile For Input As #fIndex ' 入力行の初期化 lineIndex = 1 ' 正規表現のセット Set objRegex = CreateObject("VBScript.RegExp") strPattern = "^"".*?""[,$]" With objRegex .Pattern = strPattern .ignorecase = True .Global = True End With ' ファイルの末尾まで繰り返す Do Until EOF(fIndex) ' 行単位にレコードを読み込む Line Input #fIndex, strInput ' 値の初期化 startIndex = 1 rowIndex = 0 ReDim recordArray(rowIndex) Do While startIndex <= Len(strInput) ' カンマで分ける前に、ダブルクォートに挟まれた部分を分割できないか試す ' 現在位置からの部分文字列を検索するのがポイント Set objMatches = objRegex.Execute(Mid(strInput, startIndex)) ' マッチする? If objMatches.Count > 0 Then ' 最初にマッチした部分のデータから、カラムの終了位置を探す destIndex = startIndex + Len(objMatches(0).Value) - 1 Else ' マッチしなかったなら、単なるカンマ探し destIndex = InStr(startIndex, strInput, ",", vbTextCompare) ' カンマが見つからないなら検索終了 If destIndex < startIndex Then destIndex = Len(strInput) + 1 End If End If ' 配列サイズを変更し、値を末尾に追加 ReDim Preserve recordArray(rowIndex) recordArray(rowIndex) = Trim(Mid(strInput, startIndex, destIndex - startIndex)) ' ダブルクォーテーションが存在するなら除去 If ((Left(recordArray(rowIndex), 1) = """") And (Right(recordArray(rowIndex), 1) = """")) Then recordArray(rowIndex) = Trim(Mid(recordArray(rowIndex), 2, Len(recordArray(rowIndex)) - 2)) End If ' 途中に入った二重のダブルクォートにも見栄え上の処理を施す recordArray(rowIndex) = Replace(recordArray(rowIndex), """""", """") ' 検索開始位置の更新 startIndex = destIndex + 1 rowIndex = rowIndex + 1 Loop ' レコード内容をシートに入力 If rowIndex >= 1 Then Range(Cells(lineIndex, 1), Cells(lineIndex, rowIndex)).Value = recordArray End If ' 次の行へ lineIndex = lineIndex + 1 Loop ' ファイルを閉じる Close #fIndex End Sub
と、多少強引ですが正規表現を使った分、まだ理解しやすい挙動になったのではないかと。動作も確認したので問題ないとは思いますが、何か気がついた点があれば教えて頂ければ幸いです。