Question

我有一个excel文件，用于合并在同一文件夹（Group 1，Group 2，... Group 15，Group 16）中找到的所有原始数据，使用以下代码：

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

我想在栏目中添加＆＃34; O：O＆＃34;每个文件的组号。问题在于它按字母顺序打开它们：＆＃34;第1组，第10组，第11组......第2组，第3组......＆＃34;但是小组反击仍然是：1,2,3 ......

你可以帮助我吗，我需要组计数器来匹配文件名中的数字（可能用它遇到的第一个数字填充O：O？）或者使excel打开浏览器名称后面的文件。

提前谢谢。

Answer 1

那是因为Dir（）只是转到目录中的下一个字母文件。您可以尝试将前导零置于文件名中，例如＆＃34; Group 01，Group 02，...＆＃34;

Answer 2

这就是Dir()的工作原理 - 它按字母顺序排列下一个文件。许多程序和函数实际上都遵循这个逻辑。 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

如何在合并工作簿的末尾添加特定数字

3 个答案: