こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel VBAについてお願いします 

Excelにて複数のCSVファイルを読み込んでいます。
現在使用している物は、同フォルダ内にあるcsvファイルをすべて選択しています。
そこで、毎回同じフォルダ内のcsvファイルを選択を自動化にしたいと思っています。
Const MyFol As String = "C:\AAA\AAAA\"などフォルダを固定したいです。

現在使用している物にどのように追加、変更すれば良いでしょうか?ご伝授願います

Sub CSV取り込み()
Dim csvFile As Variant
Dim fIdx As Long
Dim lngTmp As Long
Dim dCell As Range
csvFile = Application.GetOpenFilename(FileFilter:="CSVファイル,*.csv", MultiSelect:=True)
Select Case TypeName(csvFile)
Case "Variant()"
If Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
lngTmp = 0
Else
lngTmp = 1
End If
For fIdx = 1 To UBound(csvFile)
Set dCell = Cells(Rows.Count, 1).End(xlUp).Offset(lngTmp, 0)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & csvFile(fIdx), Destination:=dCell)
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
End With
If lngTmp = 1 Then dCell.EntireRow.Delete
lngTmp = 1
Next
Range("A1").AutoFilter field:=Range("O:O").Column, Criteria1:="=9"
Range("2:" & Rows.Count).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
Range("A1").AutoFilter
Set dCell = Nothing
Case Else
MsgBox "キャンセル、または不正な操作が行われました"
End Select
End Sub

どうか自動読み込みできるようお願いします。

追加で、処理終了ご『処理完了』などのメッセージがあれば、最高です

よろしくお願いします

投稿日時 - 2018-06-17 20:09:23

QNo.9509340

困ってます

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

>一行目のみ項目がはいり2行目以降はDateが読み込まれていました。
意味が解らないのですが。

前は何も考えずに、ただ結合するだけのプログラムを作ってしまいました。
プルグラムをよくみると、2つ目以降のファイルは、1行目を削除しています(多分ヘッダーでしょう)また、O列が9のものを削除しています。この機能を追加しました。
'
Option Explicit
'
Sub CSV取り込み()
'
  Const MyFol As String = "C:\Users\MA\Desktop\My Documents\質問解答\OKWAVE"
  Dim csvFile As String
  Dim lngTmp As Integer
  Dim dCell As Range
'
  ChDrive MyFol
  ChDir MyFol
  Cells.ClearContents
  lngTmp = 0
  csvFile = Dir("*.csv")
'
  While csvFile > ""
    Set dCell = Cells(Rows.Count, "A").End(xlUp).Offset(lngTmp, 0)
    With ActiveSheet.QueryTables.Add _
      (Connection:="TEXT;" & csvFile, Destination:=dCell)
      .TextFileCommaDelimiter = True
      .Refresh BackgroundQuery:=False
    End With
'
    If lngTmp = 1 Then
      dCell.EntireRow.Delete
    End If
    lngTmp = 1
    csvFile = Dir
  Wend
  Range("A1").AutoFilter field:=Range("O:O").Column, Criteria1:="=9"
  Range("2:" & Rows.Count).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
  Range("A1").AutoFilter
  MsgBox "処理完了"
End Sub

人のプログラムを見て解析するのは大変なんです。文章でもどうなって欲しいか書いて欲しいです。
これでだめなら、サンプルデータと、どうなってほしいという結果を、あげていただけませんか。

投稿日時 - 2018-06-18 23:14:35

お礼

SI299792 様
回答ありがとうございました。
どうしたいのか内容が伝わらない言葉足らずですいませんでした。
ですが、私の思い通りのVBAになっています。
本当にありがとうございました。

投稿日時 - 2018-06-19 07:58:03

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.3

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1033916180など見ればわかる。ここは、Googleで「同一フォルダーのCSVファイルを処理」で検索したら出てきた。もっとGoogle照会など、活用するべし。
ーー
要点は、ベストアンサーの中の、
>For Each FL In FLS ' コレクションを構成するファイルをひとつずつ処理
にある。
ファイルやフォルダの処理には、VBSCRIPTに勉強を広げることを勧める。

投稿日時 - 2018-06-18 20:48:05

ANo.2

'
Option Explicit
'
Sub CSV取り込み()
'
  Const MyFol As String = "C:\Users\MA\Desktop\My Documents\質問解答\OKWAVE"
  Dim csvFile As String
  Dim lngTmp As Integer
  Dim dCell As Range
'
  ChDrive MyFol
  ChDir MyFol
  Cells.ClearContents
  lngTmp = 0
  csvFile = Dir("*.csv")
'
  While csvFile > ""
    Set dCell = Cells(Rows.Count, "A").End(xlUp).Offset(lngTmp, 0)
    With ActiveSheet.QueryTables.Add _
      (Connection:="TEXT;" & csvFile, Destination:=dCell)
      .TextFileCommaDelimiter = True
      .Refresh BackgroundQuery:=False
    End With
    lngTmp = 1
    csvFile = Dir
  Wend
  MsgBox "処理完了"
End Sub

なお、OKWAVEは勝手に回答を改ざんします。この回答も改ざんされて、プログラムが動かなくなる可能性があります。

投稿日時 - 2018-06-18 18:44:53

補足

回答ありがとうございます。
ファイルを選択なしで読み込む事ができました。
ですが、使用していた物は各CSVファイルは2行になっていて(項目、Date)一行目のみ項目がはいり2行目以降はDateが読み込まれていました。
なんとか今までの処理内容の自動ファイル読み込みとはならないでしょうか?
よろしくお願いします。

投稿日時 - 2018-06-18 21:26:11

ANo.1

> Const MyFol As String = "C:\AAA\AAAA\"などフォルダを固定したいです。

csvFile = Application.GetOpenFilename
の前に
ChDrive "C" 'もし必要なら
ChDir MyFol
としておけばいかがでしょう。

> 追加で、処理終了ご『処理完了』などのメッセージがあれば、最高です

例えば
Set dCell = Nothing
の後に
MsgBox "処理完了"
としておけばいかがでしょう。

投稿日時 - 2018-06-18 14:23:30

あなたにオススメの質問