Excel VBA質問箱 IV

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

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


9397 / 13646 ツリー ←次へ | 前へ→

【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ファイルを1つのエクセルファイルにしたい)


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で全てが1行として読み込まれ
結果、列数が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
        'ファイルから1行読み込み
        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

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