Excel VBA質問箱 IV

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

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


56302 / 76736 ←次へ | 前へ→

【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
の値を変更して試してみて下さい。
極端に大きくしても駄目ですよ!!

0 hits

【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 発言

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