17

どうすればよいですか？基本的に、複数のCSVファイルを複数のワークシートにインポートしたいのですが、1つのワークブックのみにインポートします。これがループしたいVBAコードです。のすべてのCSVをクエリするためのループが必要ですC:\test\

Sub Macro()
With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;C:\test\test1.csv", Destination:=Range("$A$1"))
    .Name = "test1"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
Sheets.Add After:=Sheets(Sheets.Count)
End Sub
4

5 に答える 5

19

この男は絶対にそれを釘付けにしました。非常に簡潔なコードであり、2010年には完璧に機能します。すべての功績は彼（Jerry Beaucaire）にあります。こちらのフォーラムで見つけました。

Option Explicit
Sub ImportCSVs()
'Author:    Jerry Beaucaire
'Date:      8/16/2010
'Summary:   Import all CSV files from a folder into separate sheets
'           named for the CSV filenames

'Update:    2/8/2013   Macro replaces existing sheets if they already exist in master workbook

Dim fPath   As String
Dim fCSV    As String
Dim wbCSV   As Workbook
Dim wbMST   As Workbook

Set wbMST = ThisWorkbook
fPath = "C:\test\"                  'path to CSV files, include the final \
Application.ScreenUpdating = False  'speed up macro
Application.DisplayAlerts = False   'no error messages, take default answers
fCSV = Dir(fPath & "*.csv")         'start the CSV file listing

    On Error Resume Next
    Do While Len(fCSV) > 0
        Set wbCSV = Workbooks.Open(fPath & fCSV)                    'open a CSV file
        wbMST.Sheets(ActiveSheet.Name).Delete                       'delete sheet if it exists
        ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)    'move new sheet into Mstr
        Columns.Autofit             'clean up display 
        fCSV = Dir                  'ready next CSV
    Loop

Application.ScreenUpdating = True
Set wbCSV = Nothing
End Sub
于 2015-11-03T11:57:36.827 に答える
6

をインポートした場合にシート名が重複するようなエラーは処理されないことに注意してくださいcsv。

これはアーリーバインディングを使用するため、[ツール]の下の[参照]を参照する必要がありますMicrosoft.Scripting.Runtime。VBE

Dim fs  As New FileSystemObject
Dim fo As Folder
Dim fi As File
Dim wb As Workbook
Dim ws As Worksheet
Dim sname As String

Sub loadall()
    Set wb = ThisWorkbook

    Set fo = fs.GetFolder("C:\TEMP\")

    For Each fi In fo.Files
        If UCase(Right(fi.name, 4)) = ".CSV" Then
            sname = Replace(Replace(fi.name, ":", "_"), "\", "-")

            Set ws = wb.Sheets.Add
            ws.name = sname
            Call yourRecordedLoaderModified(fi.Path, ws)
        End If
    Next
End Sub

Sub yourRecordedLoaderModified(what As String, where As Worksheet)
With ws.QueryTables.Add(Connection:= _
    "TEXT;" & what, Destination:=Range("$A$1"))
    .name = "test1"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
Sheets.Add After:=Sheets(Sheets.Count)
End Sub
于 2012-08-28T15:45:41.480 に答える
3

を使用Dirして、ファイルのみを除外して実行csvできます

Sub MacroLoop()
Dim strFile As String
Dim ws As Worksheet
strFile = Dir("c:\test\*.csv")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
    "TEXT;" & "C:\test\" & strFile, Destination:=Range("$A$1"))
    .Name = strFile
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub
于 2012-08-28T23:04:44.490 に答える
2

データの分析を容易にするために、1つのワークブックに1つのワークシートを1つのワークシートにまとめる183のcsvファイルがあり、一度に1つずつ手動で実行したくありませんでした。この質問で最も評価の高いソリューションを試しましたが、別のユーザーと同じ問題がありました。csvファイルは開きますが、ターゲットブックには何も挿入されません。しばらく時間をかけて、Excel2016と同じように機能するようにコードを調整しました。古いバージョンではテストしていません。私は何年もの間VisualBasicでコーディングしていないので、おそらくコードに改善の余地がたくさんありますが、ピンチでうまくいきました。私のように誰かがこの質問に遭遇した場合に備えて、以下で使用したコードを貼り付けています。

Option Explicit
Sub ImportCSVs()
'Author:    Jerry Beaucaire
'Date:      8/16/2010
'Summary:   Import all CSV files from a folder into separate sheets
'           named for the CSV filenames

'Update:    2/8/2013   Macro replaces existing sheets if they already exist in master workbook
'Update: base script as seen in: https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/merge-functions/csvs-to-sheets
'Update: adjusted code to work in Excel 2016

Dim fPath   As String
Dim fCSV    As String
Dim wbName  As String
Dim wbCSV   As Workbook
Dim wbMST   As Workbook


wbName = "this is a string"
Set wbMST = ThisWorkbook

fPath = "C:\pathOfCSVFiles\"                  'path to CSV files, include the final \
Application.ScreenUpdating = False  'speed up macro
Application.DisplayAlerts = False   'no error messages, take default answers
fCSV = Dir(fPath & "*.csv")         'start the CSV file listing

    On Error Resume Next
    Do While Len(fCSV) > 0
        Set wbCSV = Workbooks.Open(fPath & fCSV)                    'open a CSV file
        If wbName = "this is a string" Then 'this is to check if we are just starting out and target workbook only has default Sheet 1
            wbCSV.Sheets.Copy After:=wbMST.Sheets(1) 'for first pass, can leave as is. if loading a large number of csv files and excel crashes midway, update this to the last csv that was loaded to the target workbook
        Else
            wbCSV.Sheets.Copy After:=wbMST.Sheets(wbName) 'if not first pass, then insert csv after last one
        End If

        fCSV = Dir                  'ready next CSV
        wbName = ActiveSheet.Name 'save name of csv loaded in this pass, to be used in the next pass
    Loop

Application.ScreenUpdating = True
Set wbCSV = Nothing
End Sub
于 2019-05-08T20:56:12.030 に答える
0

私はこれを試しませんでしたが、私はこれで行きます：

Dim NumFound As Long 
With Application.FileSearch 
    .NewSearch
    .LookIn = "C:\test\"
    .FileName = "*.csv"
    If .Execute() > 0 Then 
        For i = 1 To .FoundFiles.Count
            With ActiveSheet.QueryTables.Add(Connection:= _
                "TEXT;" & "C:\test\" & (Application.FileSearch.FoundFiles(i)), Destination:=Range("$A$1"))
                ...
            End With
            Sheets.Add After:=Sheets(Sheets.Count)
        Next i
    End If
End With
于 2012-08-28T15:43:33.837 に答える