| |
>▼さむ さん：
おはようございます。
一箇所訂正です。
>>
>標準モジュールに
>
>'=========================================================
>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 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
の値を変更して試してみて下さい。
極端に大きくしても駄目ですよ！！
|
|
ichinose
- 05/5/24(火) 7:56 -
