Question

我有一个大的excel文件（500多张），我们在每张纸上存储每日报告，每张纸用于向一张纸提供数据并制作图表。

我正在尝试制作它，以便将这些报告放入文件夹，运行宏，然后将这些复制到主文件中。主文件当前设置为使工作表名称为A1的值。

我目前的问题是我需要在A1中放入的值仅存在于文件名中，它不在任何单元格中，我无法将其添加到报告中。

报告的文件名是这样的 - "Daily report for September 21 , 2015.xls"

我所拥有的代码目前将文件复制到主文件中，但我需要能够在本例中仅使用＆＃34; 9月21日和＃34;将单元格值A1更改为9/21/15。来自文件名。

这是我目前的代码

Sub test()

     Dim Wb1 As Workbook
     Dim Wb2 As Workbook
     Dim Filename As String
     Dim Path As String
     Path = "M:\TESTCOPY\"  'CHANGE PATH
     Filename = Dir(Path & "\*.xls")

     With Application
          .ScreenUpdating = False
          .EnableEvents = False
          .DisplayAlerts = False
     End With
     Set Wb1 = Workbooks.Open(Path & Filename)
     Set Wb2 = ThisWorkbook
     Wb1.Sheets.Copy Before:=Wb2.Sheets("LAST")
     Wb1.Close False
     With Application
          .ScreenUpdating = True
          .EnableEvents = True
          .DisplayAlerts = True
     End With

End Sub

能够检查表9/21/15是否已经存在并中止副本并且能够在复制完成后删除工作表也是很好的。我知道我可以使用Kill，但我不知道在这段代码中将它放在哪里杀死Wb1。

由于

编辑：

我已经得到了一些工作，但由于我缺乏知识，它相当粗糙。我希望能够循环浏览文件夹中的文件，并学习如何摆脱嵌套的替换命令。我无法弄清楚如何使修剪正常工作，或者如果它的工作方式相同，以删除字符串中间的空格，这就是替换命令的原因。

Sub CopyReport()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim Filename As String
Dim Path As String
Dim FileDate As String
Path = "M:\TESTCOPY\"  'CHANGE PATH
Filename = Dir(Path & "\*.xls")
FileDate = Filename

'--------------------------------------------

        With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        End With
        Set Wb1 = Workbooks.Open(Path & Filename)
        Set Wb2 = ThisWorkbook
        Wb1.Sheets.Copy Before:=Wb2.Sheets("LAST")
        Wb1.Close False
        With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        End With

        Cells(1, 1).Value = Replace(Replace(Replace(Replace(Trim(Replace(Replace(FileDate, "Daily report for ", ""), ".xls", "")), ",", " "), "  ", " "), "  ", " "), " ", ",")
        Cells.FormatConditions.Delete
        Kill (Path & Filename)

        MsgBox Replace(Filename, ".xls", "") & " has been copied and deleted"

End Sub

Answer 1

我这样做，试试吧

Sub Test()
    Dim Text As String
    Dim MyDate As Date
    Dim Data() As String
    Text = "Daily report for September  21 , 2015.xls"
    Text = Replace(Text, "Daily report for ", "")
    Text = Replace(Text, ".xls", "")
    Text = Replace(Text, ",", "")
    While InStr(Text, "  ")
        Text = Replace(Text, "  ", " ")
    Wend
    Data = Split(Text, " ")
    MyDate = DateValue((Data(1) & "/" & MonthToNumber(Data(0)) & "/" &     Data(2)))
End Sub
Function MonthToNumber(ByVal Mo As String) As Integer
    Select Case Mo
        Case "September"
            MonthToNumber = 9
        Exit Function
    End Select
End Function

干杯

根据复制的文件名设置单元格值

1 个答案: