如何只用VBA替换文件名中的日期？

I have the following formula:

我有以下公式:

=IF(IFERROR(MATCH($C3,'\\share\done\[dones 05.10.2016.xls]done'!$A$2:$A$49,0),0),VLOOKUP($C3,'\\share\done\[dones 05.10.2016.xls]done'!$A$2:$B$49,2,FALSE),0)

In A1 I have another date: 10.10.2016

在A1我有另一个日期:10.10.2016

How can I replace only the date that is in the file name from the formula?

如何仅从公式中替换文件名中的日期?

Until now, I've been using this:

到现在为止,我一直在使用它:

Sub modify()
    Dim a As Range
    Set a = Range("a1")
    [e3:e4].Replace "dones 05.10.2016.xls", ("dones " & a & ".xls"), xlPart
End Sub

The problem that in A2 I have another date and F3:F4 must have the date from A2, and so on until A300. How can I replace only the date of the file name in the formula?

A2中我有另一个日期和F3:F4的问题必须是A2的日期,依此类推,直到A300。如何仅替换公式中文件名的日期?

The names of the files are standard: dones dd.mm.yyyy.xls

文件的名称是标准的:dones dd.mm.yyyy.xls

4 个解决方案

#1

Sub modify()
    Dim c As Range, r As Range
    Set c = [a1]
    Set r = [e3:e4]
    Application.DisplayAlerts = False ' optional to hide dialogs

    While c > ""
        Debug.Print c.Address(0, 0), r.Address(0, 0) ' optional to check the address

        r.Replace "[dones ??.??.????.xls]", "[dones " & c & ".xls]", xlPart
        Set c = c.Offset(1, 0) ' A1 to A2
        Set r = r.Offset(0, 1) ' E3:E4 to F3:F4
    Wend
    Application.DisplayAlerts = True
End Sub

Replace with wildcards:

替换为通配符:

[e3:e4].Replace "[dones ??.??.????.xls]", "[dones " & [a1] & ".xls]", xlPart

? matches any single character and * can be used to match 0 or more characters:

?匹配任何单个字符,*可用于匹配0个或多个字符:

[e3:e4].Replace "[*.xls*]", "[dones " & [a1] & ".xls]", xlPart

https://www.ablebits.com/office-addins-blog/2015/09/29/using-excel-find-replace/#find-replace-wildcards

#2

Instead of hard-coding "dones 05.10.2016.xls", you'll have to build that string from the cell values. Also, you'll need some looping logic to track which row you're reading from and which column you're writing to.

而不是硬编码“dones 05.10.2016.xls”,你必须从单元格值构建该字符串。此外,您需要一些循环逻辑来跟踪您正在读取的行以及您要写入的列。

Assuming a date read in row 1 goes in column 5, a date read in row 2 goes in column 6, and so on, something like this should be good enough:

假设第1行中读取的日期在第5列中,第2行中读取的日期在第6列中,依此类推,这样的内容应该足够好:

Dim targetColumn As Long
Dim sourceRow As Long

With ActiveSheet
    For sourceRow = 1 To WhateverTheLastRowIs
        targetColumn = 4 + sourceRow 'column 5 / "E" for sourceRow 1

        Dim sourceDateValue As Variant
        sourceDateValue = .Cells(sourceRow, 1).Value
        Debug.Assert VarType(sourceDateValue) = vbDate

        Dim formattedSourceDate As String
        formattedSourceDate = Format(sourceDateValue.Value, "MM.DD.YYYY")

        'replace string in rows 3 & 4 of targetColumn:
        .Range(.Cells(3, targetColumn), .Cells(4, targetColumn) _
            .Replace "[*.xls]", "[dones " & formattedSourceDate & ".xls]", xlPart
    Next
End With

#3

My understanding of the requirements is this:

我对要求的理解是这样的:

There is a List of Dates in Column A starting at Row 1

从第1行开始,列A中有一个日期列表

A formula needs to be entered in rows 3:4 starting in Column E and moving one column to the right for each value in the List of Dates, i.e. Formula in column E has date from row 1, column F has date from row 2, …

需要在列E中开始输入公式3:4并在日期列表中为每个值向右移动一列,即E列中的公式具有第1行的日期,列F具有第2行的日期, ...

This is the formula, in which the date 05.10.2016 in the filename '\\share\done\[dones 05.10.2016.xls]done should be update with corresponding value from the List of Dates as per point 2.

这是公式,其中文件名'\\ share \ done \ [dones 05.10.2016.xls]中的日期05.10.2016应该根据点2的日期列表中的相应值进行更新。

=IF( IFERROR(MATCH($C3,'\\share\done\[dones 05.10.2016.xls]done'!$A$2:$A$49,0),0), VLOOKUP($C3,'\\share\done\[dones 05.10.2016.xls]done'!$A$2:$B$49,2,FALSE),0)

= IF(IFERROR(MATCH($ C3,'\\ share \ done \ [dones 05.10.2016.xls]完成'!$ A $ 2:$ A $ 49,0),0),VLOOKUP($ C3,'\\分享\完成\ [dones 05.10.2016.xls]完成'!$ A $ 2:$ B $ 49,2,FALSE),0)

This solution assumes the dates in column A are already formated as required by the filename link.

此解决方案假定已按照文件名链接的要求格式化A列中的日期。

This solution uses a variable to hold the Link Formula and another variable to update the Link Formula with each Value in the List of Dates. Also to simplify the update\replacement of the date let’s change the original date in the formula for 05.10.2016 for an unique key such as #DATE

此解决方案使用变量来保存链接公式和另一个变量,以使用日期列表中的每个值更新链接公式。另外,为了简化更新\更换日期,我们更改05.10.2016公式中的原始日期,以获取一个唯一的密钥,例如#DATE

Dim sFmlLink As String, sFml As String
sFmlLink = "=IF(" & Chr(10) & _
    "IFERROR(MATCH($C3,'\\share\done\[dones #DATE.xls]done'!$A$2:$A$49,0),0)," & Chr(10) & _
    "VLOOKUP($C3,'\\share\done\[dones #DATE.xls]done'!$A$2:$A$49,2,FALSE),0)"

Then we set a Range with the List of Dates and loop trough it to update and enter the formula as per point 2.

然后我们使用日期列表设置一个范围并循环它以更新并按照点2输入公式。

Sub FormulaLink()
Dim sFmlLink As String, sFml As String
sFmlLink = "=IF(" & Chr(10) & _
    "IFERROR(MATCH($C3,'\\share\done\[dones #DATE.xls]done'!$A$2:$A$49,0),0)," & Chr(10) & _
    "VLOOKUP($C3,'\\share\done\[dones #DATE.xls]done'!$A$2:$A$49,2,FALSE),0)"
Dim rDates As Range, lRow As Long, iCol As Integer

    Rem Set Start Column
    iCol = 5
    With ThisWorkbook.Sheets("DATA")
        Rem Set Dates List Range
        Set rDates = Range(.Cells(1), .Cells(Rows.Count, 1).End(xlUp))
        Rem Enter Link Formula in Rows 3:4, starting at Column 5
        Rem and moving one column to the right for each Date in Column A
        For lRow = 1 To rDates.Rows.Count
            Rem Refresh Link Formula with Date from Column A
            sFml = Replace(sFmlLink, "#DATE", rDates.Cells(lRow).Value)
            Rem Enter Formula in Column iCol Rows 3:4
            .Cells(3, iCol).Resize(2).Formula = sFml
            Rem Move One Column to the right
            iCol = 1 + iCol
    Next: End With
    End Sub

#4

You will need to work with the string functions InStr and Mid here. Maybe this can help you:

您需要在此处使用字符串函数InStr和Mid。也许这可以帮助你:

Dim str As String
Dim intPos1 As Integer
Dim intPos2 As Integer
Dim intLastPos As Integer

'Formula as string
   str = "\\share\done\[dones 05-10-2016.xls]done'!$A$2:$A$49,0),0),VLOOKUP($C3,'\\share\done\[dones 05-10-2016.xls]done"

'Get the start and the End Position of the First Excel File
  intPos1 = InStr(1, str, "[dones") - 1
  intPos2 = InStr(1, str, ".xls") + 5

'Save the Last Postion for the second Replacement
  intLastPos = intPos2


'Replace old  File with [dones 01-10-1911.xls]

  str = Mid(str, 1, intPos1) & "[dones 01-10-1911.xls]" & Mid(str, intPos2, Len(str))

'Get the start and the End Position of the second Excel File
  intPos1 = InStr(intLastPos, str, "[dones")
  intPos2 = InStr(intLastPos, str, ".xls")


'Replace the second File with [dones 01-10-1911.xls]
  str = Mid(str, 1, intPos1) & "[dones 01-10-1911.xls]" & Mid(str, intPos2, Len(str))

After that you can read back the formula.

之后,您可以回读公式。

#1

Sub modify()
    Dim c As Range, r As Range
    Set c = [a1]
    Set r = [e3:e4]
    Application.DisplayAlerts = False ' optional to hide dialogs

    While c > ""
        Debug.Print c.Address(0, 0), r.Address(0, 0) ' optional to check the address

        r.Replace "[dones ??.??.????.xls]", "[dones " & c & ".xls]", xlPart
        Set c = c.Offset(1, 0) ' A1 to A2
        Set r = r.Offset(0, 1) ' E3:E4 to F3:F4
    Wend
    Application.DisplayAlerts = True
End Sub