Question

我有一个VBA脚本，它读取给定文件夹中的每个CSV，读取数据并将其放入工作簿。然后它转到下一个.csv并将该数据附加到前一组数据的最后一行。

我希望它能够将每个.csv中的数据沿着列而不是行追加，但是我在如何解决这个问题时遇到了一些麻烦。这是代码：

Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim LastRow As Long
Dim inputValue As Variant

Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

inputValue = InputBox("Input File Path:")
FolderPath = inputValue

NRow = 1

FileName = Dir(FolderPath & "*csv*")

Do While FileName <> ""

    Set WorkBk = Workbooks.Open(FolderPath & FileName)


    SummarySheet.Range("A" & NRow).Value = FileName



    LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
             After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
             SearchDirection:=xlPrevious, _
             LookIn:=xlFormulas, _
             SearchOrder:=xlByRows).Row
    Set SourceRange = WorkBk.Worksheets(1).Range("A1:B" & LastRow)

    Set DestRange = SummarySheet.Range("B" & NRow)
    Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)

    DestRange.Value = SourceRange.Value

    NRow = NRow + DestRange.Rows.Count

    WorkBk.Close savechanges:=False

    FileName = Dir()
Loop

SummarySheet.Columns.AutoFit
End Sub

Answer 1

这个宏可能会有所帮助。

Sub simpleXlsMerger() Dim bookList As Workbook Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object Application.ScreenUpdating = False Set mergeObj = CreateObject("Scripting.FileSystemObject")

'change folder path of excel files here Set dirObj = mergeObj.Getfolder("C:\Users\guillermo.rojas\Documents\Desktop\Reports\EOD") Set filesObj = dirObj.Files For Each everyObj In filesObj Set bookList
= Workbooks.Open(everyObj)

'change "A2" with cell reference of start point for every files here 'for example "B3:IV" to merge all files start from columns B and rows 3 'If you're files using more than IV column, change it to the latest column 'Also change "A" column on "A65536" to the same column as start point Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate

'Do not change the following column. It's not the same column as above Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Application.CutCopyMode = False bookList.Close Next End Sub

Answer 2

使用以下代码在SummarySheet中查找LastColumn：

LastColumn = Workbk.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column

然后使用以下代码或函数将LastColumn Number转换为字母：

LastColumnLetter = CovertToLetter(LastColumn)

Public Function ConvertToLetter(iCol As Long) As String
   Dim iAlpha As Long
   Dim iRemainder As Long
   iAlpha = Int(iCol / 27)
   iRemainder = iCol - (iAlpha * 26)
   If iAlpha > 0 Then
      ConvertToLetter = Chr(iAlpha + 64)
   End If
   If iRemainder > 0 Then
      ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
   End If
End Function

现在更改DestRange，如下所示

 DestRange = SummarySheet.Range(LastColumnLetter & 1)

然后将LastColumn的计数增加为LastColumn = LastColumn + 1

将多个.csv中的数据排序到单个工作簿中

2 个答案: