Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9839 / 13644 ツリー ←次へ | 前へ→

【25102】CAVの1行データを形式を変えてシートに貼り付けたい さむ 05/5/20(金) 11:10 質問[未読]
【25106】Re:CAVの1行データを形式を変えてシートに... m2m10 05/5/20(金) 12:21 質問[未読]
【25157】Re:CAVの1行データを形式を変えてシートに... さむ 05/5/23(月) 9:48 質問[未読]
【25170】Re:CAVの1行データを形式を変えてシートに... m2m10 05/5/23(月) 13:38 質問[未読]
【25171】Re:CAVの1行データを形式を変えてシートに... さむ 05/5/23(月) 13:58 お礼[未読]
【25188】Re:CAVの1行データを形式を変えてシートに... ichinose 05/5/24(火) 2:25 発言[未読]
【25191】Re:CAVの1行データを形式を変えてシートに... ichinose 05/5/24(火) 7:56 発言[未読]

【25102】CAVの1行データを形式を変えてシートに貼...
質問  さむ  - 05/5/20(金) 11:10 -

引用なし
パスワード
   こんにちわ。

CSVの1行のデータをセルの結合などをしているシートに貼り付けたいのですが、
どのような方法が有るでしょうか?

データの中身
"値1","値2","値3","値4","値5","値6","値7","値8","値9"

セルの形
------------------------------------------------------
  |   |        |
  |   |        |---------------------------
  |   |        |
  |   |--------------------------------------------
  |   |        |
  |   |        |---------------------------
  |   |        |
------------------------------------------------------

貼り付け結果
------------------------------------------------------
  |   |    値3   |  
  |   |----------------|   値7
  |   |    値4   |  
値1 | 値2 |--------------------------------------------
  |   |    値5   |  
  |   |----------------|  値8
  |   |    値6   |  
------------------------------------------------------

できれば1行のデータづつではなく、一括にやる方法を探しています。
自分では1行のデータづつの処理しか思いつかないので、教えてください。

【25106】Re:CAVの1行データを形式を変えてシート...
質問  m2m10  - 05/5/20(金) 12:21 -

引用なし
パスワード
   > 一括にやる方法を探しています
 有りません

例ですが 

Line Input #1 ,dt01

Split(dt01, ",")

Cells( , )

 
を使うと可能です。

【25157】Re:CAVの1行データを形式を変えてシート...
質問  さむ  - 05/5/23(月) 9:48 -

引用なし
パスワード
   ▼m2m10 さん:
>> 一括にやる方法を探しています
> 有りません
>
>例ですが 
>
>Line Input #1 ,dt01
>
> Split(dt01, ",")
>
> Cells( , )
>
> 
>を使うと可能です。

返信ありがとうございます。
返事が送れて申し訳有りません。

この方法は自分でも思いついて使ったのですが、
速度がとても遅く、使いたいデータ量を考えると
約5分かかってしまいます。
この時間では問題なので早く処理をできる方法を探しています。
何か良い方法は無いのでしょうか?

【25170】Re:CAVの1行データを形式を変えてシート...
質問  m2m10  - 05/5/23(月) 13:38 -

引用なし
パスワード
   VBAの動作(動き)を非表示にしたら、早くなります。

 ADO、DAO 等も無理ですね。

【25171】Re:CAVの1行データを形式を変えてシート...
お礼  さむ  - 05/5/23(月) 13:58 -

引用なし
パスワード
   m2m10 さんありがとうございます。

非表示にしたら1分ほど時間が縮まりました。

【25188】Re:CAVの1行データを形式を変えてシート...
発言  ichinose  - 05/5/24(火) 2:25 -

引用なし
パスワード
   ▼さむ さん:
こんばんは。

>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を変更して下さい。

【25191】Re:CAVの1行データを形式を変えてシート...
発言  ichinose  - 05/5/24(火) 7:56 -

引用なし
パスワード
   >▼さむ さん:
おはようございます。
一箇所訂正です。

>>
>標準モジュールに
>
>'=========================================================
>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 inc)
'配列の宣言を訂正しました
>  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プロシジャー内の
>  Const b_size = 10
の値を変更して試してみて下さい。
極端に大きくしても駄目ですよ!!

9839 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free