| |
このコードでは、
'論理レコードをフィールドに分割
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
|
|
Hirofumi
- 08/1/30(水) 19:41 -
