如何在合并工作簿结束时添加一个特定的编号

我有一个excel文件，用于合并在同一文件夹（组1，组2，…组15，组16）中find的所有原始数据，使用下面的代码：

Sub MergeFiles() Dim Path, Filename As String, group As Long group = 1 Path = "C:\Users\calin.lencar\Desktop\DT Project\Project Holiday Group Raw Data\" Filename = Dir(Path & "*.csv") Do While Filename <> "" And Filename <> "Digital Tracking Panel KPIs v1" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True LastRow = Range("A65536").End(xlUp).Row Range("O2", Cells(LastRow, "O")).Value = group Range("A2:X" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(21).Activate Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Application.CutCopyMode = False Workbooks(Filename).Close Filename = Dir() group = group + 1 Loop MsgBox "Files have been copied successfully" End Sub 

我试图在每个文件的组号“O：O”列中join。 问题是，它按字母顺序打开：“第1组，第10组，第11组…第2组，第3组…”，但组计数器仍然是：1,2,3 …

你能帮我吗？我需要组计数器来匹配文件名中的数字（也许用遇到的第一个数字填充O：O），或者在资源pipe理器名称后打开excel文件。

先谢谢你。

Answer 1

这是因为Dir（）只是转到目录中的下一个字母文件。 您可以尝试将一个前导零置于“组01，组02，…”之类的文件名中

Answer 2

这是Dir()工作原理 – 按字母顺序排列下一个文件。 许多程序和function实际上都遵循这个逻辑。 Dir（）MSDN。

但是，如果您拥有1到15的所有文件，并且名称相同，则可以尝试以下操作：

 Option Explicit Public Sub TestMe() Dim firstPart As String Dim i As Long firstPart = "Group " For i = 1 To 15 Debug.Print firstPart & i & ".xlsx" 'now open this file Next i End Sub 

它会工作。 打开之前，请考虑检查文件Group 7.xlsx是否存在。

Answer 3

我尝试使用函数来获得第一个数字（前1或2位数），并将其添加到我需要的列。

 Function Number(txt As String) As String With CreateObject("VBScript.RegExp") .Pattern = "\d{1,2}" Number = .Execute(txt)(0) End With End Function Sub MergeFiles() Dim Path, Filename As String Path = "C:\Users\calin.lencar\Desktop\DT Project\Project Holiday Group Raw Data\" Filename = Dir(Path & "*.csv") Do While Filename <> "" And Filename <> "Digital Tracking Panel KPIs v1" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True LastRow = Range("A65536").End(xlUp).Row Range("O2", Cells(LastRow, "O")).Value = Number(Filename) Range("A2:X" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(21).Activate Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Application.CutCopyMode = False Workbooks(Filename).Close Filename = Dir() Loop MsgBox "Files have been copied successfully" End Sub