Question

我在一个文件夹中有多个文件，总是有一张纸。我需要根据原始文件的名称和日期将这些单独的文件合并到具有多个工作表的中央工作簿中，这些工作簿与原始工作簿相同。

例如，在文件夹中，我可能有以下文件：

Fund1809_Equity_20140917
Fund1809_FI_20140917
Fund1809_Unlisted_20140917
Fund1809_Equity_20141221
Fund1809_FI_20141221
Fund780_Equity_20140917
Fund68092_Equity_20140917

我需要将具有相同基金名称和日期的所有文件放入工作簿中。因此，预期结果应为4个工作簿：

Fund1089_20140917带有“权益”，“FI”和“不公开”标签
Fund1089_20141221带有“权益”和“FI”标签
Fund780_20140917带有“权益”标签
Fund68092_20140917，带有“权益”标签

我的代码根据基金名称的前4个字符进行排序。因此，我遇到了问题，因为基金代码的长度没有固定为4，也没有根据日期排序。这是我的代码：

Sub test()
Const TO_DELETE_SHEET_NAME As String = "toBeDeleted"
'------------------------------------------------------------------
Dim settingSheetsNumber As Integer
Dim settingDisplayAlerts As Boolean
Dim dict As Object
Dim wkbSource As Excel.Workbook
Dim wks As Excel.Worksheet
Dim filepath As String
Dim code As String * 4
Dim wkbDestination As Excel.Workbook
Dim varKey As Variant
Dim sourceFolder As String
Dim destinationFolder As String
'------------------------------------------------------------------

'Change [SheetsInNewWorkbook] setting of Excel.Application object to
'create new workbooks with a single sheet only.
With Excel.Application
    settingDisplayAlerts = .DisplayAlerts
    settingSheetsNumber = .SheetsInNewWorkbook
    .SheetsInNewWorkbook = 1
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

Set dict = VBA.CreateObject("Scripting.Dictionary")

sourceFolder = "C:\Users\ThomasK\Desktop\Test\"
destinationFolder = "C:\Users\ThomasK\Desktop\"
filepath = Dir(sourceFolder)

'Loop through each Excel file in folder
Do While filepath <> ""

    If VBA.Right$(filepath, 5) = ".xlsx" Then

        Set wkbSource = Excel.Workbooks.Open(sourceFolder & filepath)
        Set wks = wkbSource.Worksheets(1)
        code = VBA.Left$(wkbSource.Name, 4)

        'If this code doesn't exist in the dictionary yet, add it.
        If Not dict.exists(code) Then
            Set wkbDestination = Excel.Workbooks.Add
            wkbDestination.Worksheets(1).Name = TO_DELETE_SHEET_NAME
            Call dict.Add(code, wkbDestination)
        Else
            Set wkbDestination = dict.Item(code)
        End If

        Call wks.Copy(Before:=wkbDestination.Worksheets(1))
        wkbDestination.Worksheets(1).Name = VBA.Mid$(filepath, 6)

        Call wkbSource.Close(False)

    End If

    filepath = Dir

Loop

'Save newly created files.
For Each varKey In dict.keys
    Set wkbDestination = dict.Item(varKey)

    'Remove empty sheet.
    Set wks = Nothing
    On Error Resume Next
    Set wks = wkbDestination.Worksheets(TO_DELETE_SHEET_NAME)
    On Error GoTo 0

    If Not wks Is Nothing Then wks.Delete

    Call wkbDestination.SaveAs(Filename:=destinationFolder & varKey & ".xlsx")

    Call wkbDestination.Close(True)

Next varKey

'Restore Excel.Application settings.
With Excel.Application
    .DisplayAlerts = settingDisplayAlerts
    .SheetsInNewWorkbook = settingSheetsNumber
End With

End Sub

正则表达式是否需要识别基金名称？

根据文件的名称和日期将文件夹中的工作簿合并到中央工作簿中

0 个答案: