我想知道是否有人可以帮助我。
我将以下代码放在一起,通过“浏览”窗口,用户可以在从每个文件中提取相关数据之前导航到所选文件,并将它们合并为“摘要”表。
Sub ConsolidateTimeRecording()
Dim DestWB As Workbook
Dim dR As Long
Dim Fd As FileDialog
Dim LastRow As Long
Dim SourceSheet As String
Dim sFile As String
Dim sPath As String
Dim StartRow As Long
Dim wb As Workbook
Dim ws As Worksheet
Set DestWB = ActiveWorkbook
SourceSheet = "Input"
StartRow = 2
Range("B4:N4").Select
Selection.AutoFilter
' Select the folder that contains the files
Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
With Fd
'.InitialFileName = "DefaultPath"
If .Show = -1 Then
sPath = Fd.SelectedItems(1) & "\"
End If
End With
Set Fd = Nothing
' Directory in the folder
sFile = Dir(sPath)
Do While sFile <> ""
Set wb = Workbooks.Open(Filename:=sFile, ReadOnly:=True, Password:="master")
For Each ws In wb.Worksheets
If ws.Name = SourceSheet Then
With ws
If .UsedRange.Cells.count > 1 Then
dR = DestWB.Worksheets("Time Recording").Range("B" & DestWB.Worksheets("Time Recording").Rows.count).End(xlUp).Row + 1
If dR < 5 Then dR = 6 'destination start row
LastRow = .Range("A" & Rows.count).End(xlUp).Row
If LastRow >= StartRow Then
.Range("A" & StartRow & ":M" & LastRow).Copy
DestWB.Worksheets("Time Recording").Cells(dR, "B").PasteSpecial xlValues
DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Name = "Lucida Sans"
DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Size = 10
DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).NumberFormat = "#,##0.00"
DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).HorizontalAlignment = xlCenter
End If
End If
End With
Exit For
End If
Next ws
wb.Close savechanges:=False
' Next file in folder
sFile = Dir
Loop
Application.CutCopyMode = False
msg = MsgBox("All Time Recording files have been consolidated", vbInformation)
Columns("B:N").AutoFit
End Sub
我现在正在尝试修改此问题,但我对如何推进此问题有点不确定。
这就是我想要实现的目标:
包含“Source”文件的文件夹的文件路径如下:
D:\ Work Files \ November \ Time Recording
因此,当显示输入框时,它将处于“工作文件”级别。
正如我所说,尽管对此进行了研究,但我对如何进行修改仍不太了解。
我只是想知道某人是否能够看到这一点并提供一些关于如何实现这一目标的指导。
非常感谢和亲切的问候
答案 0 :(得分:1)
通过进一步的研究,我找到了两篇帖子here和here,这些帖子帮助我让我的脚本工作如下:
Sub ConsolidateTimeRecording()
Dim DestWB As Workbook
Dim dR As Long
Dim Fd As FileDialog
Dim LastRow As Long
Dim SourceSheet As String
Dim sFile As String '****New line
Dim sMidFile As String '****New line
Dim StartRow As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim excelfile As Variant
Set DestWB = ActiveWorkbook
SourceSheet = "Input"
StartRow = 2
Range("B4:N4").Select
Selection.AutoFilter
MidFile = InputBox("Please Enter The Month You Wish To Open")
sFile = "D:\Work Files\" & MidFile & "\Time Recording\"
excelfile = Dir(sFile & "*.xls")
Do While excelfile <> ""
Set wb = Workbooks.Open(Filename:=sFile & excelfile, ReadOnly:=True, Password:="master")
For Each ws In wb.Worksheets
If ws.Name = SourceSheet Then
With ws
If .UsedRange.Cells.count > 1 Then
dR = DestWB.Worksheets("Time Recording").Range("B" & DestWB.Worksheets("Time Recording").Rows.count).End(xlUp).Row + 1
If dR < 5 Then dR = 6 'destination start row
LastRow = .Range("A" & Rows.count).End(xlUp).Row
If LastRow >= StartRow Then
.Range("A" & StartRow & ":M" & LastRow).Copy
DestWB.Worksheets("Time Recording").Cells(dR, "B").PasteSpecial xlValues
DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Name = "Lucida Sans"
DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Size = 10
DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).NumberFormat = "#,##0.00"
DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).HorizontalAlignment = xlCenter
End If
End If
End With
Exit For
End If
Next ws
wb.Close savechanges:=False
' Next file in folder
excelfile = Dir
Loop
Application.CutCopyMode = False
msg = MsgBox("All Time Recording files have been consolidated", vbInformation)
Columns("B:N").AutoFit
End Sub