Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9395 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【27582】複数のCSVファイルの読み込み方 R＠プログラム初心者 05/8/12(金) 14:34 質問[未読]
【27588】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 15:25 回答[未読]
【27591】Re:複数のCSVファイルの読み込み方 R＠プログラム初心者 05/8/12(金) 15:56 質問[未読]
【27594】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 16:13 回答[未読]
【27595】Re:複数のCSVファイルの読み込み方 R＠プログラム初心者 05/8/12(金) 16:19 質問[未読]
【27596】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 16:38 回答[未読]
【27597】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 16:49 回答[未読]
【27598】Re:複数のCSVファイルの読み込み方 R＠プログラム初心者 05/8/12(金) 16:52 質問[未読]
【27600】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 17:00 発言[未読]
【27599】Re:複数のCSVファイルの読み込み方 Hirofumi 05/8/12(金) 16:57 発言[未読]
【27601】Re:複数のCSVファイルの読み込み方 R＠プログラム初心者 05/8/12(金) 17:07 質問[未読]
【27603】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 17:12 回答[未読]
【27604】Re:複数のCSVファイルの読み込み方 Hirofumi 05/8/12(金) 17:19 発言[未読]
【27606】Re:複数のCSVファイルの読み込み方 R＠プログラム初心者 05/8/12(金) 17:27 質問[未読]
【27608】Re:複数のCSVファイルの読み込み方 Hirofumi 05/8/12(金) 18:22 回答[未読]
【27610】Re:複数のCSVファイルの読み込み方 だるま 05/8/12(金) 20:25 回答[未読]
【27582】複数のCSVファイルの読み込み方
質問  R＠プログラム初心者  - 05/8/12(金) 14:34 -
引用なし
パスワード
   はじめまして。
R＠プログラム初心者です。

ExcelVBAをはじめました。

以前の書き込み【25952】にありました
複数csvファイルの読込みに似ているのですが、
複数のCSVファイルのすべての行を読み込むためにはどのようにすれば
よいのでしょうか？
(複数のCSVファイルを１つのエクセルファイルにしたい)


file1.csv
aaa,aaa,aaa,...,aaa
bbb,bbb,bbb,...,bbb

file2.csv
ccc,ccc,ccc,...,ccc
ddd,ddd,ddd,...,ddd

↓

Excelファイル（1シートに：カンマ区切り→各セルに）
file.xls
aaa,aaa,aaa,...,aaa
bbb,bbb,bbb,...,bbb
ccc,ccc,ccc,...,ccc
ddd,ddd,ddd,...,ddd


ご教授お願いします。
【27588】Re:複数のCSVファイルの読み込み方
回答  だるま WEB  - 05/8/12(金) 15:25 -
引用なし
パスワード
   こんにちは

こんな感じでいかがでしょうか。^d^

Sub ReadCSV()
　　Dim myPath As String
　　Dim Fname As String
　　Dim N As Integer
　　Dim rngDest As Range
　　Dim myArray As Variant
　　Dim D As String
　　Dim i As Integer
　　
　　myPath = ThisWorkbook.Path & "\"
　　Set rngDest = Worksheets("Sheet1").Range("A1")
　　
　　Application.ScreenUpdating = False
　　
　　Fname = Dir(myPath & "*.csv")
　　Do Until Fname = ""
　　　　N = FreeFile
　　　　Open myPath & Fname For Input As #N
　　　　Do Until EOF(N)
　　　　　　Line Input #N, D
　　　　　　myArray = Split(D, ",")
　　　　　　rngDest.Resize(1, UBound(myArray) + 1).Value = myArray
　　　　　　Set rngDest = rngDest.Offset(1)
　　　　Loop
　　　　Close #N
　　　　Fname = Dir()
　　Loop
　　
　　Application.ScreenUpdating = True
　　Set rngDest = Nothing
End Sub
【27591】Re:複数のCSVファイルの読み込み方
質問  R＠プログラム初心者  - 05/8/12(金) 15:56 -
引用なし
パスワード
   ＞だるまさん

早々のレスありがとうございます。

初心者なもので理解できない部分があります。

この3行はどういう処理を意味しているのか教えてください。

myArray = Split(D, ",")
rngDest.Resize(1, UBound(myArray) + 1).Value = myArray
Set rngDest = rngDest.Offset(1)


よろしくお願いします。
【27594】Re:複数のCSVファイルの読み込み方
回答  だるま WEB  - 05/8/12(金) 16:13 -
引用なし
パスワード
   >この3行はどういう処理を意味しているのか教えてください。
>
>myArray = Split(D, ",")
読み込んだ一行のデータを、カンマを区切り文字として配列に分割して入れています。

>rngDest.Resize(1, UBound(myArray) + 1).Value = myArray
書き込み先セルを一時的に、配列の大きさ分横に拡張し、そこに上記配列の値を入れて
います。

>Set rngDest = rngDest.Offset(1)
書き込み先を一行下に設定し直しています。

こんな説明でどうでしょうか。
より詳しくはヘルプをご覧ください。^d^
【27595】Re:複数のCSVファイルの読み込み方
質問  R＠プログラム初心者  - 05/8/12(金) 16:19 -
引用なし
パスワード
   ▼だるま さん：

またまた早々のレスありがとうございます。

>rngDest.Resize(1, UBound(myArray) + 1).Value = myArray

の行に
アプリケーション定義またはオブジェクト定義エラーというものが出ます。

エクセルはExcel2000を使用しています。

定義というレベルになると僕にはまだ難しいのでしょうか？
【27596】Re:複数のCSVファイルの読み込み方
回答  だるま WEB  - 05/8/12(金) 16:38 -
引用なし
パスワード
   >>rngDest.Resize(1, UBound(myArray) + 1).Value = myArray
>
>の行に
>アプリケーション定義またはオブジェクト定義エラーというものが出ます。

一応動作確認はしてからアップしましたのでプログラムは間違っていないと思いますが
エラーの原因はわかりません。

どなたかから回答が付くと良いのですが。^d^
【27597】Re:複数のCSVファイルの読み込み方
回答  だるま WEB  - 05/8/12(金) 16:49 -
引用なし
パスワード
   もしかして列数が256列を超えているなんてことは無いですよね。^d^
【27598】Re:複数のCSVファイルの読み込み方
質問  R＠プログラム初心者  - 05/8/12(金) 16:52 -
引用なし
パスワード
   列数は40列です。

再度コピー＆ペーストで確かめてみましたが
同じエラーがでました。

ランタイム等は関係ありませんか？？
【27599】Re:複数のCSVファイルの読み込み方
発言  Hirofumi  - 05/8/12(金) 16:57 -
引用なし
パスワード
   ▼R＠プログラム初心者 さん：
>▼だるま さん：
>
>またまた早々のレスありがとうございます。
>
>>rngDest.Resize(1, UBound(myArray) + 1).Value = myArray
>
>の行に
>アプリケーション定義またはオブジェクト定義エラーというものが出ます。
>
>エクセルはExcel2000を使用しています。
>
>定義というレベルになると僕にはまだ難しいのでしょうか？

これ、CSVに空行（改行コードだけの行）が有るのでは？
当方、Excel97なので、Split関数のHelpが無いのでハッキリしませんが？
確か、Split関数に""を渡すと、上限が-1の配列を返してきた様な気がします
詰まり、「UBound(myArray) + 1」が0に成るのでエラーに成るのでは？
【27600】Re:複数のCSVファイルの読み込み方
発言  だるま WEB  - 05/8/12(金) 17:00 -
引用なし
パスワード
   ▼R＠プログラム初心者 さん：
>列数は40列です。
>
>再度コピー＆ペーストで確かめてみましたが
>同じエラーがでました。
>
>ランタイム等は関係ありませんか？？
関係ありません。

エラーは実行直後から出ますか。
つまり一行も読み込まないうちから出ますか、それともある程度読み込んでから
途中で出るのでしょうか。
【27601】Re:複数のCSVファイルの読み込み方
質問  R＠プログラム初心者  - 05/8/12(金) 17:07 -
引用なし
パスワード
   ▼だるま さん：
エラーは何も行に表示されないまま出ています。
ランタイムはインストールしましたが、おっしゃるとおり全く
関係ないみたいでした。

▼Hirofumi さん：
1行の中のカンマの間が空白の箇所が数箇所ありました。
これが原因でしょうか？？
【27603】Re:複数のCSVファイルの読み込み方
回答  だるま WEB  - 05/8/12(金) 17:12 -
引用なし
パスワード
   空白行対応型にしてみました。^d^

Sub ReadCSV()
　　Dim myPath As String
　　Dim Fname As String
　　Dim N As Integer
　　Dim rngDest As Range
　　Dim myArray As Variant
　　Dim D As String
　　Dim i As Integer
　　
　　myPath = ThisWorkbook.Path & "\"
　　Set rngDest = Worksheets("Sheet1").Range("A1")
　　
　　Application.ScreenUpdating = False
　　
　　Fname = Dir(myPath & "*.csv")
　　Do Until Fname = ""
　　　　N = FreeFile
　　　　Open myPath & Fname For Input As #N
　　　　Do Until EOF(N)
　　　　　　Line Input #N, D
　　　　　　If D <> "" Then
　　　　　　　　myArray = Split(D, ",")
　　　　　　　　rngDest.Resize(1, UBound(myArray) + 1).Value = myArray
　　　　　　End If
　　　　　　Set rngDest = rngDest.Offset(1)
　　　　Loop
　　　　Close #N
　　　　Fname = Dir()
　　Loop
　　
　　Application.ScreenUpdating = True
　　Set rngDest = Nothing
End Sub
【27604】Re:複数のCSVファイルの読み込み方
発言  Hirofumi  - 05/8/12(金) 17:19 -
引用なし
パスワード
   ▼R＠プログラム初心者 さん：
>▼だるま さん：
>エラーは何も行に表示されないまま出ています。
>ランタイムはインストールしましたが、おっしゃるとおり全く
>関係ないみたいでした。
>
>▼Hirofumi さん：
>1行の中のカンマの間が空白の箇所が数箇所ありました。
>これが原因でしょうか？？

此れでは有りません
私の言っているのは、改行コードだけの行です
後、考えられるのは、改行コードがvbLfで全てが１行として読み込まれ
結果、列数が256を超えているか？

何れにしても、ブレイク（停止）した時、

Input #N, D

の「D」をマウスでポイントして見ましょう
もし、空行なら""が表示されるでしょう
また、Uboundの所をウオッチで見られれば解るかな？
【27606】Re:複数のCSVファイルの読み込み方
質問  R＠プログラム初心者  - 05/8/12(金) 17:27 -
引用なし
パスワード
   ▼だるま さん：
新しいソースで行いましたが、
同じエラーが出ました。

▼Hirofumi さん：
>列数が256を超えているか？

280ありました。
【27608】Re:複数のCSVファイルの読み込み方
回答  Hirofumi  - 05/8/12(金) 18:22 -
引用なし
パスワード
   改行コードがLfの可能性が有るので
此れで、やって見て、Csvファイルは、マクロの有るBookと同じフォルダに有るとしています
拡張子.csvのファイルを全て抜き出し読み込みます
また、読み込む先は、ActiveSheetのA1からとしています

Option Explicit

Public Sub CSVReadFSO()
　　
'　 CSVデータの読み込み
　　
　　Const ForReading = 1

　　Dim i As Long
　　Dim rngWrite As Range
　　Dim lngRow As Long
　　Dim strPath As String
　　Dim vntFileNames As Variant
　　Dim vntField As Variant
　　Dim strBuff As String
　　Dim objFso As Object
　　Dim objFileStr As Object
　　Dim strProm As String
　　
　　'書き込む位置を設定
　　Set rngWrite = ActiveSheet.Cells(1, "A")
　　
　　'FSOのオブジェクトを取得
　　Set objFso = CreateObject("Scripting.FileSystemObject")
　　
　　'読み込むファイルのフォルダを設定
　　strPath = ThisWorkbook.Path
　　'指定フォルダからファイル名を取得
　　If Not GetFilesList(vntFileNames, strPath, objFso, "csv", ".*") Then
　　　　strProm = "ファイルが有りません"
　　　　GoTo Wayout
　　End If
　　
　　Application.ScreenUpdating = False
　　
　　For i = 1 To UBound(vntFileNames)
　　　　'指定ファイルを読み込みモードでOpen
　　　　Set objFileStr = objFso.OpenTextFile(vntFileNames(i), ForReading)
　　　　With objFileStr
　　　　　　Do Until .AtEndOfStream
　　　　　　　　'ファイルから１行読み込み
　　　　　　　　strBuff = .ReadLine
　　　　　　　　If strBuff <> "" Then
　　　　　　　　　　'CSVをフィールドに分割
　　　　　　　　　　vntField = Split(strBuff, ",")
　　　　　　　　　　'指定シートの指定行列位置について
　　　　　　　　　　With rngWrite.Offset(lngRow)
　　　　　　　　　　　　'フィールドの書き込み
　　　　　　　　　　　　.Resize(, UBound(vntField) + 1).Value = vntField
　　　　　　　　　　End With
　　　　　　　　　　'書き込み行位置を更新
　　　　　　　　　　lngRow = lngRow + 1
　　　　　　　　End If
　　　　　　Loop
　　　　　　'ファイルをClose
　　　　　　.Close
　　　　End With
　　Next i
　　
　　strProm = "処理が完了しました"
　　
Wayout:
　　
　　Application.ScreenUpdating = True
　　
　　Set objFileStr = Nothing
　　Set objFso = Nothing
　　Set rngWrite = Nothing
　　
　　Beep
　　MsgBox strProm
　　
End Sub

Private Function GetFilesList(vntFileNames As Variant, _
　　　　　　　　　　　　　　strFilePath As String, _
　　　　　　　　　　　　　　objFso As Object, _
　　　　　　　　　　　　　　Optional strExtePattan As String = ".*", _
　　　　　　　　　　　　　　Optional strNamePattan As String = ".*") As Boolean
　　
　　Dim i As Long
　　Dim objFiles As Object
　　Dim objFile As Object
　　Dim regExten As Object
　　Dim regName As Object
　　Dim vntRead() As Variant
　　Dim strName As String
　　
　　'フォルダの存在確認
　　If Not objFso.FolderExists(strFilePath) Then
　　　　GoTo Wayout
　　End If
　　
　　'regExtenpのオブジェクトを取得（正規表現を作成）
　　Set regExten = CreateObject("VBScript.RegExp")
　　With regExten
　　　　'パターンを設定
　　　　.Pattern = strExtePattan
　　　　'大文字と小文字を区別しないように設定
　　　　.IgnoreCase = True
　　End With
　　Set regName = CreateObject("VBScript.RegExp")
　　With regName
　　　　'パターンを設定
　　　　.Pattern = strNamePattan
　　　　'大文字と小文字を区別しないように設定
　　　　.IgnoreCase = True
　　End With
　　
　　'フォルダオブジェクトを取得
　　Set objFiles = objFso.GetFolder(strFilePath).Files
　　
　　'ファイルの数が0でなければ
　　If objFiles.Count <> 0 Then
　　　　For Each objFile In objFiles
　　　　　　With objFile
　　　　　　　　strName = .Name
　　　　　　　　'検索をテスト
　　　　　　　　If regExten.Test(objFso.GetExtensionName(strName)) Then
　　　　　　　　　　If regName.Test(objFso.GetBaseName(strName)) Then
　　　　　　　　　　　　i = i + 1
　　　　　　　　　　　　ReDim Preserve vntRead(1 To i)
　　　　　　　　　　　　vntRead(i) = strName
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　End With
　　　　Next objFile
　　End If
　　
　　Set regExten = Nothing
　　Set regName = Nothing
　　
　　If i <> 0 Then
　　　　ReDim vntFileNames(1 To UBound(vntRead))
　　　　For i = 1 To UBound(vntRead)
　　　　　　vntFileNames(i) _
　　　　　　　　　　= strFilePath & "\" & vntRead(i)
　　　　Next i
　　　　GetFilesList = True
　　End If
　　
Wayout:

　　'フォルダオブジェクトを破棄
　　Set objFiles = Nothing
　　Set objFile = Nothing
　　
End Function
【27610】Re:複数のCSVファイルの読み込み方
回答  だるま WEB  - 05/8/12(金) 20:25 -
引用なし
パスワード
   Hirofumiさんが立派なコードを提示されてますのでもう必要ないかもしれません
が一応修正してみましたので。^d^
(一括で読み込みvbLFで行に分けるようにしてみました。)

Sub ReadCSV()
　　Dim myPath As String
　　Dim Fname As String
　　Dim N As Integer
　　Dim rngDest As Range
　　Dim myArray0 As Variant
　　Dim myArray As Variant
　　Dim D As String
　　Dim i As Integer
　
　　myPath = ThisWorkbook.Path & "\"
　　Set rngDest = Worksheets("Sheet1").Range("A1")
　
　　Application.ScreenUpdating = False
　
　　Fname = Dir(myPath & "*.csv")
　　Do Until Fname = ""
　　　　N = FreeFile
　　　　Open myPath & Fname For Input As #N
　　　　D = InputB(LOF(N), N)
　　　　D = StrConv(D, vbUnicode)
　　　　Close #N
　　　　
　　　　myArray0 = Split(D, vbLf)
　　　　For i = 0 To UBound(myArray0)
　　　　　　myArray = Split(CStr(myArray0(i)), ",")
　　　　　　rngDest.Resize(1, UBound(myArray) + 1).Value = myArray
　　　　　　Set rngDest = rngDest.Offset(1)
　　　　Next
　　　　Fname = Dir()
　　Loop
　
　　Application.ScreenUpdating = True
　　Set rngDest = Nothing
End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9395 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free