2

インターネットで多くのことを検索した後、フォルダー内のすべての .csv ファイルを読み取る Excel VBA コードを Excel ファイル (それぞれ別のワークシート上) に結合しようとしました。しかし、私が必要とする唯一のことは、すべての csv ファイルを 1 つのワークシートに結合することです....

作業コードは次のとおりです。

作業ファイルを個別のワークシートに

Sub Example12()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook

'Fill in the path\folder where the files are
'on your machine
MyPath = "c:\Data"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.csv")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp

Application.ScreenUpdating = False
Set basebook = ThisWorkbook

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.Count)

On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0

' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With

mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub
---------------------------------------------------------

But the change i've made was to change the part where the VBA copies it into a sheet "after" the last one, to append it to a existing sheet "Totaal".

not working code
---------------------------------------------------------

Sub Example12()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook

'Fill in the path\folder where the files are
'on your machine
MyPath = "c:\Data"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.csv")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp

Application.ScreenUpdating = False
Set basebook = ThisWorkbook

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
mybook.Worksheets(1).Copy

**basebook.Sheets("Totaal").Select
NextRow = Cells(Rows.Count, 0).End(xlUp).Row
Cells(NextRow, 1).Select
ActiveSheet.Paste**

On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0

' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange.Value = .Value
' End With

mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub

これを変更する知識がありません:(。私は正しい軌道に乗っていましたか?

すべてのご意見をお待ちしております。

追加情報: CSV ファイルのデータは最初の列に配置されます。マージプロセス全体の後、後で列に分割する予定でした....

ありがとう！

4

2 に答える 2

2

後 Set basebook = ThisWorkbook

これを入力してください：

Dim nextRow As Integer
Dim wsTotal As Worksheet
Set wsTotal = basebook.Worksheets("Total")

修正された For ループは次のとおりです。

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
    For Fnum = LBound(MyFiles) To UBound(MyFiles)

        'open file
        Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))

        With wsTotal

            'activate if you want (optional)
            '.Activate

            'copy all the data on the sheet
            mybook.Worksheets(1).UsedRange.Copy

            'find the next empty row
            nextRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1

            'select if desired (optional)
            '.Cells(NextRow, 1).Select

            'paste the data
            .Cells(nextRow, 1).PasteSpecial (xlPasteAll)

            'turn off copy mode
            Application.CutCopyMode = False

            'Do you really want to change the worksheet name?
            .Name = mybook.Name
        End With

        'close file
        mybook.Close savechanges:=False

    Next Fnum
于 2013-07-15T15:47:14.200 に答える
0

csv ファイルをインポートするには、ファイルを開く代わりにクエリを使用することをお勧めします。このようにして、外出先でデータから列への分割を実行することもできます。

Sub ImportToNewWorksheet(ImpFileName as String)
 Dim mySheet As Worksheet
 Set mySheet = ThisWorkbook.Worksheets.Add
 Call ImportFile(ImpFileName, mySheet.Cells(1,1))
End Sub

Sub ImportFile(ImpFileName As String, ImpDest As Range)
 With ImpDest.Worksheet.QueryTables.Add(Connection:= _
  "TEXT;" & ImpFileName, Destination:=ImpDest)
  .Name = "Import"
  .FieldNames = True
  .RowNumbers = False
  .FillAdjacentFormulas = False
  .PreserveFormatting = True
  .RefreshOnFileOpen = False
  .RefreshStyle = xlOverwriteCells
  .SavePassword = False
  .SaveData = True
  .AdjustColumnWidth = True
  .RefreshPeriod = 0
  .TextFilePromptOnRefresh = False
  .TextFilePlatform = 65001
  .TextFileStartRow = 1
  .TextFileParseType = xlDelimited
  .TextFileTextQualifier = xlTextQualifierDoubleQuote
  .TextFileConsecutiveDelimiter = False
  .TextFileTabDelimiter = False
  .TextFileSemicolonDelimiter = False
  .TextFileCommaDelimiter = True
  .TextFileSpaceDelimiter = False
  .TextFileColumnDataTypes = Array(1, 1, 1, 1)
  .TextFileTrailingMinusNumbers = True
  .Refresh BackgroundQuery:=False
 End With

End Sub
于 2013-07-15T12:55:29.483 に答える