• ベストアンサー
  • すぐに回答を!

CSV

  • 質問No.3211856
  • 閲覧数839
  • ありがとう数2
  • 回答数3

お礼率 58% (20/34)

複数の定型フォームのCSVファイルを1エクセルファイルにして、エクセル上で集計まで行いたいと思っています。

今、「教えて!goo」から検索で、VBAを使って、CSVファイルをエクセルの1シートにまとめることはできたのですが、
・シート名を特定の名前にしたい
・同ファイル内の、既存の「TTL」というシート上で合計を表示させたい

のですが、シート名が定まらないので設定ができません。
どうか、設定方法を教えてください。

VBA式は以下のとおり
↓↓↓
Dim MyObj As Object
Dim MyFol As String
Dim MyFnm As String
Dim MyStr As String
Dim i As Long
Dim n As Long
Dim n1 As Long

'フォルダを選択する
Set MyObj = CreateObject("Shell.Application") _
.BrowseForFolder(0, "SelectFolder", 0)
'選択なければ処理を抜ける
If MyObj Is Nothing Then Exit Sub
MyFol = MyObj.self.Path & "\"
MsgBox MyFol & "を処理します。"
Set MyObj = Nothing
Application.ScreenUpdating = False
'ThisWorkbookにシートを追加して処理
With Sheets.Add
'Dir関数を使って指定フォルダ内csvファイルを順次処理
MyFnm = Dir(MyFol & "*.csv")
Do Until Len(MyFnm) = 0&
i = i + 1
'データエリアを取得してセット先を変更
n = IIf(n = 0, 1, n + n1)
'外部データ取り込みを利用
With .QueryTables.Add(Connection:="TEXT;" & MyFol & MyFnm, _
Destination:=.Range("B" & n))
.AdjustColumnWidth = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileCommaDelimiter = True
.Refresh False
n1 = .ResultRange.Rows.Count
.Parent.Names(.Name).Delete
.Delete
End With
'ファイル名をA列にセット
.Range("A" & n).Resize(n1).Value = MyFnm
'次のファイルへ
MyFnm = Dir()
Loop
End With
If i > 0 Then
MyStr = i & "個のファイルを処理しました。"
Else
'検索結果が0なら
MyStr = "検索条件を満たすファイルはありません。"
End If
Application.ScreenUpdating = True
MsgBox MyStr

質問者が選んだベストアンサー

  • 回答No.2
  • ベストアンサー

ベストアンサー率 57% (3570/6233)

こんにちは。

これは、キーワードを見つけたら、その次のキーワードの直前までをインポートします。

.BrowseForFolder(0, "フォルダを選んだください。", 0, 5)
と、5を入れることによって、My Documents フォルダになります。

If InStr(1, LineBuf, KEYWORD, vbBinaryCompare) >

キーワードの文字比較は、BynaryCompare ですから、全角、半角、大文字、小文字を区別しますが、もし、その部分を、一緒にするには、vbTextCompare モードというものがあります。
なお、.csv ファイルは、現在は、あくまでも、「,(コンマ切り)」のみの対応です。

Sub ImportCSV()
  Dim myShell As Object
  Dim myFol As String
  Dim Fn As String
  Dim Fno As Integer
  Dim LineBuf As String
  Dim ArBuf As Variant
  Dim EndCol As Integer
  Dim n As Long
  Dim k As Long
  Dim flgKey As Integer
  'キーワード
  Const KEYWORD As String = "A1"
  
  Set myShell = CreateObject("Shell.Application") _
    .BrowseForFolder(0, "フォルダを選んだください。", 0, 0) '最後の0を 5にすると、My Documents
    If myShell Is Nothing Then Exit Sub
  With myShell
    If .Self.Path = "" Then Exit Sub
    myFol = .Self.Path & "\"
    If MsgBox(myFol & vbCrLf & "上記フォルダを処理します。よろしいですか?", vbInformation + vbOKCancel) = vbCancel Then
      Exit Sub
    End If
  End With
  'シートのチェック
  On Error Resume Next
  Application.Goto Worksheets("TTL").Range("A1")
  If Err.Number = 0 Then
      If MsgBox("既に、'TTL' シートは存在しています。" & vbCrLf _
      & "シートのデータを削除しますか?", vbInformation + vbOKCancel) = vbCancel Then
      Exit Sub
      Else
       ActiveSheet.Cells.Clear
      End If
     Err.Clear
  Else
   Worksheets.Add
   ActiveSheet.Name = "TTL"
  End If
  
  On Error GoTo 0
  'インポート
  Application.ScreenUpdating = False
  With ActiveSheet
    Fn = Dir(myFol & "*.csv") 'ワイルドカード
    n = 1
    Do Until Len(Fn) = 0
      Fno = FreeFile
      Open Fn For Input As #Fno
        flgKey = 0
      Do While Not EOF(Fno)
        Line Input #Fno, LineBuf
        If InStr(1, LineBuf, KEYWORD, vbBinaryCompare) > 0 And flgKey = 0 Then
          flgKey = 1
        ElseIf InStr(1, LineBuf, KEYWORD, vbBinaryCompare) > 0 And flgKey = 1 Then
          flgKey = 2
        End If
        If flgKey = 1 Then
          ArBuf = Split(LineBuf, ",")
          EndCol = UBound(ArBuf)
          k = k + 1
          '2列目に出力
          ActiveSheet.Cells(k, 2).Resize(, EndCol) = ArBuf
        ElseIf flgKey = 2 Then
          Exit Do
        End If
      Loop
      If k > n Then
       'ファイル名の書き出し
       .Range("A" & n).Resize(k - n + 1).Value = Fn
        n = k + 1
      End If
      Fn = Dir()
    Loop
  End With
    Application.ScreenUpdating = True

End Sub

その他の回答 (全2件)

  • 回答No.3

ベストアンサー率 57% (3570/6233)

#2のコードの修正をお願いします

   End If
  End With   'おそらく22行目
Set myShell = Nothing
  'シートのチェック

その22行目の後に、Set myShell = Nothing
を入れて、解放させておいてください。ただし、特に、それを入れなくても支障はないはずですが、置き忘れは、あまりコード的に良くありません。
お礼コメント
IWA_OKOSHI

お礼率 58% (20/34)

ご対応ありがとうございました。

これからどんどん改良していきたいと思います。accessの便利さに今ちょっと感動しています。

この問い合わせを完了させて頂きます。
ありがとうございました。
投稿日時:2007/08/02 12:38
  • 回答No.1

ベストアンサー率 57% (3570/6233)

こんにちは。

あまり、他人のコードを細かく調べるつもりはありませんが、

>・シート名を特定の名前にしたい

それは、単に、

With Sheets.Add
としているだけですから、
その後に、
ActiveSheet.Name = "○○○"

>・同ファイル内の、既存の「TTL」というシート上で合計を表示させたい

そのコードですと、最終行が出るはすですから、
TTL のシートに、

n の変数を再利用して、

Worksheets("TTL").Range("A1").FormulaLocal = "=SUM(○○○!B1:B" & n & ")"

とすればよいはずです。
お礼コメント
IWA_OKOSHI

お礼率 58% (20/34)

できました。希望通りです。ありがとうございました。
即回答も助かりました。勉強になります・・・。
重ねて、ありがとうございました。
投稿日時:2007/07/30 14:45
関連するQ&A

その他の関連するQ&Aをキーワードで探す

ピックアップ

ページ先頭へ