2

我不确定如何解决这个问题。我做了很多研究，但我发现的大多数答案与我需要的有点不同。

我想要完成的是：

  1. 手动打开现有工作簿 (wbAI)，
  2. 启动宏，
  3. 使用 msoFileDialogOpen 查找并打开文件（称为 wb2），
  4. 将wb2的部分文件名（文件名中有日期）存储为变量或字符串。（我不确定哪个更适合这个目的。也许我不需要全部存储......），
  5. 将 wb2 的部分文件名（日期）粘贴到 wb1 的某个单元格中，
  6. 从 wb2 复制必要的数据，
  7. 将数据粘贴到 wb1 中，
  8. 格式化数据，
  9. 对粘贴的数据使用 VLOOKUP，
  10. 关闭 wb2 而不保存
  11. 结束宏。

我的宏可以完成上面列出的每一步，除了数字四和五。一方面，我想知道我需要如何追求这一点，另一方面，我想知道这将适合我当前的代码中的什么位置。

举一个我正在谈论的例子：假设在第三步中我打开了一个名为“01.31.13 Group Names”的工作簿。文件路径来自 Sharepoint 站点，因此看起来像这样：

“ https://company.com/team/teamone/_layouts/xlviewer.aspx?01.31.13%20Group%20Names%20.xlsm&Source=https ......”

如何仅选择文件名/文件路径中的日期？

这是我的代码的开头：

Sub Test()

Dim lastRow As Long, i As Long
Dim ws As Worksheet
Dim wbSource As Workbook
Dim wbAI As Workbook
Dim vrtSelectedItem As Variant

Set wbAI = ActiveWorkbook
Application.ScreenUpdating = False 

With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = https://company.com/team/teamone & "\"
    .AllowMultiSelect = False
    .Show
    '  ******  Is this where the new code could be inserted? *******
   For Each vrtSelectedItem In .SelectedItems
   Set wbSource = Workbooks.Open(vrtSelectedItem)
   Next
   End With
   ' Check if the first cell contains data. If not then close file
   If Range("Profile!H9") = "" Then
        ActiveWorkbook.Close savechanges:=False
        ActiveWorkbook.Saved = False

欢迎任何建议！感谢您的时间！

编辑：这就是我的代码在 Philip 的建议之后的样子：

Sub Test()

Dim lastRow As Long, i As Long
Dim ws As Worksheet
Dim wbSource As Workbook
Dim wbAI As Workbook
Dim vrtSelectedItem As Variant

Set wbAI = ActiveWorkbook
Application.ScreenUpdating = False 

With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = https://company.com/team/teamone & "\"
    .AllowMultiSelect = False
    .Show

   For Each vrtSelectedItem In .SelectedItems
   Set wbSource = Workbooks.Open(vrtSelectedItem)
   Next
   End With
   dateVar = Left(wbSource.Name, 8) '<~~~~ New code
   ' Check if the first cell contains data. If not then close file
   If Range("Profile!H9") = "" Then
        ActiveWorkbook.Close savechanges:=False
        ActiveWorkbook.Saved = False
   Else
        Sheets("Profile").Activate
        Range("H9:I" & Cells(Rows.Count, "H").End(xlUp).Row).Select
        Selection.Copy
        Windows("wbName").Activate
        Sheets("Sheet1").Activate
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("E1").Value = dateVar '<~~~ New code
4

1 回答 1

5

从文件名中，您将使用LEFT FUNCTION 返回日期的 LEFT 8 个字符：

dateVar=left(wbSource.name, 8)

然后你可以把它放在你的单元格中：

rangeVar.value=dateVar

希望这能让你继续前进

菲利普

于 2013-03-25T15:41:30.197 回答