Question

我正在研究一个宏来重新格式化和编辑三个工作簿。这三个工作簿总是分别具有相同的名称，并且来自相同的源。它们以.csv格式到达。我想要的是VBA将所有这三个工作簿作为单独的工作表导入到一本书中，并根据每个工作簿标题中的字符串重命名这些工作表。有没有一种简单的方法将其附加到录制的宏？此外，有没有比录制宏生成的方式更好的导入和分隔/格式化文件的方法？我已经放置了以下方法的代码：

With ActiveSheet.QueryTables.Add(Connection:= _
    "FAKENAME.csv" _
    , Destination:=Range("$A$1"))
    .CommandType = 0
    .Name = "FAKENAME"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .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, 1, 3, 3, 1, 1, 1, 1, 1, 1, 1, 1, 3, 1, 1, 1, 1, 1, _
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 1, 1, 1, 1, 1, 1, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
    , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With

Answer 1

我建议使用以下内容作为打开CSV并将其添加到输出Workbook的更简单的方法：

Option Explicit
Sub ImportCSVsToSheets()

Dim File As String, Path As String
Dim CSV As Workbook, Book As Workbook
Dim CS As Worksheet, Sheet As Worksheet
Dim LastRow As Long, LastCol As Long
Dim Source As Range, Target As Range

'set references up-front
Application.DisplayAlerts = False
Path = "c:\my\csv\files\"
File = Dir(Path & "*.csv")
Set Book = Workbooks.Add

'output workbook setup, make it bare-bones by deleting all non-first sheets
For Each Sheet In Book.Worksheets
    If Sheet.Index <> 1 Then
        Sheet.Delete
    End If
Next Sheet
Set Sheet = Book.Worksheets(1)
Sheet.Name = "DeleteMeSoon"

'loop through the CSVs and write data to sheets in output book
Do While Len(File) > 0
    'set up CSV and determine copy range
    Set CSV = Workbooks.Open(Path & File)
    Set CS = CSV.ActiveSheet
    With CS
        LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        Set Source = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
    End With

    'set up new sheet and destination range
    Set Sheet = Book.Worksheets.Add
    With Sheet
        Set Target = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
    End With

    'copy data from CSV to target
    Source.Copy Target

    'set the sheet name using the CSV file name
    Sheet.Name = Left(Left(File, Len(File) - 4), 31)

    'close the CSV and repeat
    CSV.Close SaveChanges:=False
    File = Dir
Loop

'remove that last pesky sheet
Set Sheet = Book.Worksheets("DeleteMeSoon")
Sheet.Delete

'save it however you'd like and boom we're done
'Book.SaveAs Filname:="a-file-name", FileFormat:=xlWhatever
Application.DisplayAlerts = True
End Sub

使用VBA导入和重命名.CSV文件

1 个答案: