| |
はじめまして、たまにこちらでお世話になってる者です。
以前どこかのサイトでCSV形式のデータを取り込む記述があったので、それをそのまま使用していたのですが最近調子よくありません。
ある行からずれが生じます。
A列に来るはずのものが最終列にきます。
取り込んだあとに自分が使用するために変数の宣言を追加しました。その際にデータ型を間違えて変えてしまった可能性もあるのですが、それが原因とも思えません。
何処が間違っているか教えてください。
もしこれ以外に取り込める記述があればそれでもかまいません。
個人的には下記のものがきにいっていましたが、、。
Option Explicit
--------------------------------------------------------------------------- Sub CSV取り込み()
Dim MYy, MYm, MYd, FileType, Prompt As String
Dim FileNamePath As Variant
Dim csvline() As String
Dim i, j, k, Mycnt, Rowcnt, ColumNum As Integer
Dim ch1 As Long
Dim Rng1, Rng2 As Range
Dim Mydate As Date
FileType = "CSV ﾌｧｲﾙ (*.csv),*.csv"
Prompt = "CSV File を選択してください"
'操作したいファイルのパスを取得します
FileNamePath = SelectFileNamePath(FileType, Prompt)
If FileNamePath = False Then 'キャンセルボタンが押された
End
End If
'1行あたりの項目数を取得します
ColumNum = GetItemNum(FileNamePath)
'csvlineを1行あたりの項目数で再割り当てます
ReDim csvline(1 To ColumNum)
'空いているファイル番号を取得します
ch1 = FreeFile
'FileNamePath のファイルをオープンします
Open FileNamePath For Input As #ch1
'エラーが発生したらファイルを閉じます
'CSVのファイルは1行の項目数が正確に合っていないと読めないのですが、
'色々なCSVがあるようなので入れておきます
On Error GoTo CloseFile
'表の行番号の初期化 1行目から読み込んだデータを入力します
Rowcnt = 1
Do While Not EOF(ch1) 'ファイルの終端かどうかを確認します。
For i = 1 To ColumNum
Input #ch1, csvline(i) '1行の項目数だけ読み込みます
Next
'配列渡しでセルに代入 この方が早い
Range(Cells(Rowcnt, 1), Cells(Rowcnt, ColumNum)) = csvline()
Rowcnt = Rowcnt + 1
Loop
Range("A1").CurrentRegion.Font.Size = 8
CloseFile:
'ファイルを閉じます
Close #ch1
--------------------------------------------------------------------------
Function SelectFileNamePath(FileType, Prompt) As Variant
SelectFileNamePath = Application.GetOpenFilename(FileType, , Prompt)
End Function
--------------------------------------------------------------------------- Function GetItemNum(FileNamePath) As Integer
Dim ch1 As Long
Dim textline As String
'空いているファイル番号を取得します
ch1 = FreeFile
'FileNamePath のファイルをオープンします
Open FileNamePath For Input As #ch1
Line Input #ch1, textline '1行だけ読み込みます。
Close #ch1
GetItemNum = 1
'1行中のカンマの数を数えます
Do
GetItemNum = GetItemNum + 1
textline = Mid(textline, InStr(textline, ",") + 1)
Loop Until InStr(textline, ",") = 0
End Function
|
|
ととろ
- 06/9/2(土) 20:53 -
