|
▼さむ さん:
こんばんは。
>CSVの1行のデータをセルの結合などをしているシートに貼り付けたいのですが、
>どのような方法が有るでしょうか?
>
>データの中身
>"値1","値2","値3","値4","値5","値6","値7","値8","値9"
>
>セルの形
>------------------------------------------------------
> | | |
> | | |---------------------------
> | | |
> | |--------------------------------------------
> | | |
> | | |---------------------------
> | | |
>------------------------------------------------------
>
>貼り付け結果
>------------------------------------------------------
> | | 値3 |
> | |----------------| 値7
> | | 値4 |
>値1 | 値2 |--------------------------------------------
> | | 値5 |
> | |----------------| 値8
> | | 値6 |
>------------------------------------------------------
m2m10さんとのやり取りで現状5分程度の処理とおっしゃっていましたが、
CSVのデータ数が何行程度のもので5分なのですか?
こういう情報がないと考えても現状より速くなっているのかわからないので
困ってしまいます。
test.csvに
>"値1","値2","値3","値4","値5","値6","値7","値8","値9"
というデータ行が1万行程あるものでテストしました。
この値1から値8を格納するセル範囲を確定します。
値1 ----- A1からA4を結合したセル
値2 ----- B1からB4を結合したセル
値3 ----- C1
値4 ----- C2
値5 ----- C3
値6 ----- C4
値7 ----- D1からD2を結合したセル
値8 ----- D3からD4を結合したセル
つまり、4行、4列の結合を含むセル範囲と言う事になります。
CSVデータが1万行あれば、シートには4万行が出力される計算になります。
では、コードです。
標準モジュールに
'=========================================================
Sub main()
Application.ScreenUpdating = False
Const b_size = 10
Dim r_locate(1 To 8, 1 To 2)
r_locate(1, 1) = 1: r_locate(1, 2) = 1
r_locate(2, 1) = 1: r_locate(2, 2) = 2
r_locate(3, 1) = 1: r_locate(3, 2) = 3
r_locate(4, 1) = 2: r_locate(4, 2) = 3
r_locate(5, 1) = 3: r_locate(5, 2) = 3
r_locate(6, 1) = 4: r_locate(6, 2) = 3
r_locate(7, 1) = 1: r_locate(7, 2) = 4
r_locate(8, 1) = 3: r_locate(8, 2) = 4
If open_csv(ThisWorkbook.Path & "\test.csv", r_locate()) = 0 Then
idx = 1
Do Until get_csv(ans, 4, 4, b_size) = 1
Range(Cells(idx, 1), Cells((idx + 4 * b_size - 1), 4)).Value = ans
idx = idx + 4 * b_size
Loop
Call close_csv
End If
Application.ScreenUpdating = True
End Sub
別の標準モジュールに
'==================================================================
Private mylocate '値を入れる位置を示す配列
Private flno As Long 'ファイル番号
'==================================================================
Function open_csv(flnm As String, rlocate() As Variant) As Long
'指定されたCSVファイルをオープンする
'INPUT
' flnm ---- CSVファイルのフルパス
' 値を入れる位置を指定する配列
' 例
' A1とC2とD3に値を配置する場合
' dim rlocate(1 to 3,1 to 2)
' rlocate(1,1)=1:rlocate(1,2)=1 ---- A1の行と列
' rlocate(2,1)=2:rlocate(2,2)=3 ---- C2の行と列
' rlocate(3,1)=3:rlocate(3,2)=4 ---- D3の行と列
'OUTPUT
' open_csv-----0正常終了 その他---エラー
On Error Resume Next
open_csv = 0
mylocate = rlocate()
flno = FreeFile()
Open flnm For Input As #flno
If Err.Number <> 0 Then
open_csv = Err.Number
MsgBox Err.Description
End If
On Error GoTo 0
End Function
'================================================================
Function get_csv(myvalue, inr, inc, bufsz) As Long
'inr(行)inc(列)で指定された配列内にopen_csvで設定したrlocateで
'示される位置にCSVデータを格納して出力する
'INPUT
' inr,inc ---inr(行)、inc(列)で配列の大きさを指定する
' bufsz ---CSVデータを何行一括で読み込むかを指定する
'OUTPUT
' myvalue-----rlocateで示される位置に値を格納したinr行、inc列の配列
' get_csv-----0:正常に取得 1:データの終わり
Dim buff As String
Dim barray As Variant
Dim r_idx As Long
ReDim wk(1 To inr * bufsz, 1 To bufsz * inr)
l_c = LBound(mylocate, 2)
r_idx = 0
Do Until EOF(flno)
Line Input #flno, buff$
barray = Split(buff$, ",")
b_idx = 0
For idx = LBound(mylocate, 1) To UBound(mylocate, 1)
wk(r_idx * inr + mylocate(idx, l_c), mylocate(idx, l_c + 1)) = Replace(barray(LBound(barray) + b_idx), """", "")
b_idx = b_idx + 1
Next
r_idx = r_idx + 1
If r_idx >= bufsz Then Exit Do
Loop
If r_idx > 0 Then
myvalue = wk()
Erase wk()
get_csv = 0
Else
get_csv = 1
End If
End Function
'===================================================================
Sub close_csv()
' csvファイルのクローズ
On Error Resume Next
Close #flno
On Error GoTo 0
End Sub
これでMainを実行してみて下さい。
1万行で2分40秒かかっています。
尚、CSV1万行分の結合セルを作成すると(4万行)ブックを開くのには
ずいぶん時間がかかりました。
セルの位置が違う場合は、Mainを変更して下さい。
|
|