【问题标题】:excel vba macro to merge csv files into a new excel worksheet and removing subsequent headers which are 3 linesexcel vba 宏将 csv 文件合并到一个新的 excel 工作表中并删除后续的 3 行标题
【发布时间】:2015-12-18 17:03:12
【问题描述】:

我从这里的代码开始:(Merge multiple csv files in one excel sheet)

 Sub Example12()
 Dim MyPath As String
 Dim FilesInPath As Variant
 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:\Users\Downloads\merge"

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

'If there are no csv 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
Dim nextRow As Integer
Dim wsTotal As Worksheet
Set wsTotal = basebook.Worksheets("Total")


'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)

    '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
   End If
   CleanUp:
   Application.ScreenUpdating = True
   End Sub

我不确定发生了什么,但它运行没有错误,但我没有看到任何结果。我也不确定应该在哪里使用 CSV 文件中的所有文本创建我的 excel 文件(文件名)。我的 csv 文件有许多列名,这些列名在我的所有 csv 文件中重复,并且工作表名称与 csv 文件名(如 Document_15679990 等)相同,这可能是问题所在。我想更改代码以能够选择文件夹中的文件而不是所有文件,但使用以下代码类型不匹配时出错并将 FilesinPath 更改为变体,但代码中仍然出现错误。

  FilesInPath = Application.GetOpenFilename("CSV Files (*.csv), *.csv", , "Select CSV Files", "Select", True)

我还想删除随后重复的 3 行标题。任何关于它在哪里创建 excel 工作表以及使用什么名称或它是否退出子的解释?非常感谢对代码进行一些更改以满足我的要求.

【问题讨论】:

  • 最简单的:Shell("cmd /c copy *.csv all.csv", vbNormalFocus)
  • 我写了这段代码,但它所做的只是打开带有提到位置的命令窗口。我需要在此处键入此命令 copy .csv all.csv 我如何更改代码以自行执行此操作。 ' Sub merge() Dim vPID As Variant Dim myPath As Variant myPath = "C:\Users\Downloads\merge" vPID = Shell("cmd \c copy" & myPath & ".csv" & myPath & "all.csv" , vbNormalFocus) End Sub ' 还有我怎样才能删除重复的 3 行标题

标签: excel vba


【解决方案1】:

我不确定这是你的问题,但是

nextRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1

会给你一个错误的结果。

如果你写入一个单元格,如果你清除它,那个单元格将被xlCellTypeLastCell计数

此代码将显示您可能遇到的错误:

Sub test()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
         ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = "TmpSheet"
With ws
    a = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
    MsgBox ("LastCell Is: " & a & vbCrLf & "Now I'll insert some data")
    .Range("A5") = "Test"
    .Range("B9") = "Test"
    MsgBox ("Now I'll clear inserted data")
    .Range("A5:B9").Clear
    a = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
    MsgBox ("Now LastCell Is: " & a)
End With
Application.DisplayAlerts = False
    ws.Delete
Application.DisplayAlerts = True
End Sub

因此,请尝试使用您确定已填充最后一行的列并使用:

nextRow = .Cells(Rows.Count, "B").End(xlUp).Row + 1 'Change "B" to your column

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2015-07-30
    • 2013-09-15
    • 1970-01-01
    相关资源
    最近更新 更多