| |
▼Hirofumi さん：
回答ありがとうございます。
とても参考になりました。
返信遅れてスミマセン、回答して頂いた内容をもとにテストしていたので...。
>このコードでは、
>
> '論理レコードをフィールドに分割
> vntField = SplitCsv(strRec, strDelim, , , blnMulti)
>
>の所で上記の「vntField」と言う配列変数に、Csvの第1フィールドがvntField(0)、
>第2フィールドがvntField(1)、第3フィールドがvntField(2)・・と言う形に入ります
>そして、その「vntField」(1レコード分)を其のまま出力しています
>そこで、質問の
>
>>というコード､CSVデータの項目毎に列を指定したい場合は
>>どのようになりますか？
>>
>>１項目->A列、２項目->D列、３項目->C列 とか。
>
>と言う場合は、幾つかの方法が有りますが2つほど
>1、新しい出力用配列を用意して、1レコード分づつその配列に変更指定順番に転記してそれを出力する
>2、読み込み時には、そのまま読み込ませ、全てシートに出力し終わった時点で、
> 最終行の下に変更する順の番号を出力して、其れをKeyとして列方向の整列を行い、整列後に整列Keyを削除
>
>まず1を考えた場合、以下の様に成ります
>
>Private Sub CSVRead(ByVal strFileName As String, _
> ByRef rngWrite As Range, _
> Optional ByRef lngRow As Long = 1, _
> Optional ByVal lngStart As Long = 1, _
> Optional strDelim As String = ",")
>
>' strFileName：Csvのファイル名
>' rngWrite：出力基準位置、
>' lngRow：出力行位置
>' lngStart：Csv読み込み開始行
>
> Dim i As Long
> Dim j As Long '★追加
> Dim dfn As Integer
> Dim vntField As Variant
> Dim strBuff As String
> Dim blnMulti As Boolean
> Dim strRec As String
> '読み込み順を指定する配列
> Dim vntOrder As Variant '★追加
> '出力用配列
> Dim vntResult As Variant '★追加
>
> '出力順を指定(１項目->A列、２項目->D列、３項目->C列)
> '出力用配列の頭から順にCsvのどの位置のフィールドを
> '持ってくるか指定する（ただし、-1は空欄とする）
> vntOrder = Array(0, -1, 2, 1) '★追加
> '出力用配列を確保
> ReDim vntResult(UBound(vntOrder)) '★追加
>
> i = 0 '★追加
> j = 0 '★追加
> 'ファイルをOpen
> dfn = FreeFile
> Open strFileName For Input As dfn
>
> Do Until EOF(dfn)
> '１行読み込み
> Line Input #dfn, strBuff
> '論理レコードに物理レコードを追加
> strRec = strRec & strBuff
> '論理レコードをフィールドに分割
> vntField = SplitCsv(strRec, strDelim, , , blnMulti)
> 'フィールド内で改行が有る場合
> If Not blnMulti Then
> '読み込み行数のカウントをとる
> i = i + 1
> If i >= lngStart Then
> With rngWrite.Offset(lngRow)
> '出力範囲を文字列に設定
>' .Offset(, 1).Resize(, 2).NumberFormat = "@"
> '5列目の半角スペースをLfに置き換える
> On Error Resume Next
> vntField(4) = Replace(vntField(4), " ", vbLf, , , vbBinaryCompare)
> '列変更順に出力用配列に元データを代入
> For j = 0 To UBound(vntOrder) '★追加
> '空欄は飛ばす
> If vntOrder(j) > -1 Then '★追加
> vntResult(j) = vntField(vntOrder(j)) '★追加
> End If '★追加
> Next j '★追加
> On Error GoTo 0
> 'データを出力
>' .Resize(, UBound(vntField) + 1).Value = vntField
> .Resize(, UBound(vntResult) + 1).Value = vntResult '★変更
> End With
> '出力行をインクリメント
> lngRow = lngRow + 1
> End If
> Application.StatusBar = "読み込み中です．．．．" & i & " レコード目"
> strRec = ""
> Else
> 'セル内改行として残す場合
> strRec = strRec & vbLf
> End If
> Loop
>
> Close #dfn
>
>End Sub
|
|
GON
- 08/2/1(金) 14:04 -
