Question

我已将多个CSV文件合并为一个大文本文件。每次文本文件中有2个空行时，我需要将此文本文件导入Excel并创建一个新工作表。

是否有可以执行此操作的宏？

Example.TXT文件：

"Date","Country","Price",
"12/01/12","US","$4.99",
"12/02/12","US","$4.99",


"Date","Country","Price",
"12/01/13","US","$4.99",
"12/02/13","US","$4.99",


"Date","Country","Price",
"12/01/14","US","$4.99",
"12/02/14","US","$4.99",

Answer 1

我几周前准备了类似的东西，然后我进行了一些调整，以便我可以使用你的例子。但请记住，SO不是请求代码的网站。

以下内容应该有效。但在您将CSV文件导入工作表之前，它应该是这样的：

Behavior Changes

Sub CopyData()

Dim cell As Range
Dim SourceWorksheet As Worksheet
Set SourceWorksheet = ActiveSheet

Dim TempFirstRowNumber As Long: TempFirstRowNumber = 1

For Each cell In Intersect(SourceWorksheet.Range("A:A"), SourceWorksheet.UsedRange)
    If cell.Value = "" And cell.Offset(1, 0).Value = "" Then
        Sheets.Add after:=ActiveSheet
        SourceWorksheet.Range("A" & TempFirstRowNumber & ":C" & (cell.Row - 1)).Copy ActiveSheet.Range("A1")

        TempFirstRowNumber = cell.Offset(2, 0).Row
    End If
Next cell

Sheets.Add after:=ActiveSheet
SourceWorksheet.Range("A" & TempFirstRowNumber & ":C" & (SourceWorksheet.UsedRange.Rows.Count)).Copy ActiveSheet.Range("A1")

End Sub

Answer 2

以下是整个模块代码表。将其粘贴到新的空白工作簿中的新模块代码表中时，请不要在页面顶部留下两条Option Explicit Sub split_Date_Tables() Dim rowCurr As Long, tbl As Long Dim tlc As String, pth As String, fn As String, pthfn As String Dim fnd As Range On Error GoTo bm_Safe_Exit 'set up the application environment for speed (see Sub appTGGL below) appTGGL bTGGL:=False pth = Environ("TEMP") fn = "example.txt" pthfn = pth & Chr(92) & fn tlc = "Date" 'header text in the Top-Left-Corner of each table 'get rid of everything but the first blank worksheet Do While Sheets.Count > 1 Sheets(2).Delete Loop 'Importing a TXT is a lot of code that largely means nothing but has to set paramteters. 'Put it in its own sub Call importTXT(Worksheets(1), pthfn, "txtSource") With Worksheets(1) With .Columns(1) Set fnd = .Find(What:=tlc, LookIn:=xlValues, _ after:=.Cells(Rows.Count), _ LookAt:=xlWhole, SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, MatchCase:=False) Do While Not fnd Is Nothing rowCurr = fnd.Row tbl = tbl + 1 On Error GoTo bm_New_Worksheet With Worksheets(Format(tbl, "\C\S\V\-\000")) On Error GoTo bm_Safe_Exit .Cells.Clear fnd.CurrentRegion.Copy _ Destination:=.Cells(1, 1) End With Set fnd = .FindNext(after:=fnd) If rowCurr > fnd.Row Then Exit Do Loop On Error GoTo bm_Safe_Exit End With .Activate End With GoTo bm_Safe_Exit bm_New_Worksheet: If Err.Number = 9 Then With Worksheets.Add(after:=Sheets(Sheets.Count)) .Name = Format(tbl, "\C\S\V\-000") End With Resume End If bm_Safe_Exit: appTGGL End Sub Sub importTXT(ws As Worksheet, fn As String, nam As String) With ws 'nuke all existing data on this worksheet in favour of hte new data .Cells.Clear 'bring in the new data With .QueryTables.Add(Connection:="TEXT;" & fn, _ Destination:=.Range("$A$1")) .Name = nam .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlOverwriteCells .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(3, 2, 1, 9) .Refresh BackgroundQuery:=False End With 'we do not need to save this Data Connection. Get rid of it .Parent.Connections(.Parent.Connections.Count).Delete End With End Sub Sub appTGGL(Optional bTGGL As Boolean = True) Application.ScreenUpdating = bTGGL Application.EnableEvents = bTGGL Application.DisplayAlerts = bTGGL Application.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual) End Sub行。

{{1}}

IMO，这是一个非常好的框架，您可以根据自己的目的进行构建和自定义。为了让它第一次运行，您必须修改代码开头附近的字符串赋值。具有不同表格布局的CSV可能必须修改实际的导入子过程。

两点：

您的示例CSV显示尾随逗号。这会在右侧留下空白区域。我从导入中丢弃了这些字段。例如xlSkipColumn = 9
你的约会很模糊。我已经猜到了MDY格式。使用TextFileColumnDataTypes property中的值来调整要导入的字段类型。

Answer 3

好的，你们没人帮忙。所以我刚刚删除了大文本文件，并创建了一个宏来导入所有原始的csv＆＃39; s。

Sub LoadAllFilesPerSheet()
Dim idx As Integer
Dim fpath As String
Dim fname As String
idx = 0
fpath = "c:\foobar\"
fname = Dir(fpath & "*.csv")
While (Len(fname) > 0)
    idx = idx + 1
    Sheets("Sheet" & idx).Select
    Sheets.Add After:=ActiveSheet
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
      & fpath & fname, Destination:=Range("A1"))
        .Name = "a" & idx
        .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
        .TextFileOtherDelimiter = ""
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
        fname = Dir
    End With
Wend

End Sub

导入TXT文件并为每个分组表创建新工作表

3 个答案: