| |
▼さむ さん：
こんばんは。
>CSVの1行のデータをセルの結合などをしているシートに貼り付けたいのですが、
>どのような方法が有るでしょうか？
>
>データの中身
>"値１","値2","値3","値4","値5","値6","値7","値8","値9"
>
>セルの形
>------------------------------------------------------
> | | |
> | | |---------------------------
> | | |
> | |--------------------------------------------
> | | |
> | | |---------------------------
> | | |
>------------------------------------------------------
>
>貼り付け結果
>------------------------------------------------------
> | | 値3 |
> | |----------------| 値7
> | | 値4 |
>値1 | 値2 |--------------------------------------------
> | | 値5 |
> | |----------------| 値8
> | | 値6 |
>------------------------------------------------------
ｍ2ｍ10さんとのやり取りで現状５分程度の処理とおっしゃっていましたが、
CSVのデータ数が何行程度のもので５分なのですか？
こういう情報がないと考えても現状より速くなっているのかわからないので
困ってしまいます。
test.csvに
>"値１","値2","値3","値4","値5","値6","値7","値8","値9"
というデータ行が1万行程あるものでテストしました。
この値1から値8を格納するセル範囲を確定します。
値1 ----- Ａ１からＡ４を結合したセル
値2 ----- Ｂ１からＢ４を結合したセル
値3 ----- Ｃ１
値4 ----- Ｃ２
値5 ----- Ｃ３
値6 ----- Ｃ４
値7 ----- Ｄ１からＤ２を結合したセル
値8 ----- Ｄ３からＤ４を結合したセル
つまり、４行、４列の結合を含むセル範囲と言う事になります。
CSVデータが１万行あれば、シートには４万行が出力される計算になります。
では、コードです。
標準モジュールに
'=========================================================
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ファイルをオープンする
'ＩＮＰＵＴ
' flnm ---- CSVファイルのフルパス
' 値を入れる位置を指定する配列
' 例
' Ａ１とＣ２とＤ３に値を配置する場合
' dim rlocate(1 to 3,1 to 2)
' rlocate(1,1)=1:rlocate(1,2)=1 ---- Ａ１の行と列
' rlocate(2,1)=2:rlocate(2,2)=3 ---- Ｃ２の行と列
' rlocate(3,1)=3:rlocate(3,2)=4 ---- Ｄ３の行と列
'ＯＵＴＰＵＴ
' 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データを格納して出力する
'ＩＮＰＵＴ
' inr,inc ---inr（行）、inc（列）で配列の大きさを指定する
' bufsz ---CSVデータを何行一括で読み込むかを指定する
'ＯＵＴＰＵＴ
' 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を実行してみて下さい。
１万行で2分40秒かかっています。
尚、ＣＳＶ1万行分の結合セルを作成すると（4万行）ブックを開くのには
ずいぶん時間がかかりました。
セルの位置が違う場合は、Mainを変更して下さい。
|
|
ichinose
- 05/5/24(火) 2:25 -
