Question

我有以下公式：

=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)

在A1我有另一个日期：10.10.2016

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

到现在为止，我一直在使用它：

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

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

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

Answer 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

替换为通配符：

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

?匹配任何单个字符，*可用于匹配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

Answer 2

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

假设第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

Answer 3

我对要求的理解是：

从第1行开始，列A中有一个日期列表
需要在列3:4中的行E中输入公式，并为日期列表中的每个值向右移动一列，即列E中的公式已包含行1的日期，列F的日期来自行2，...
这是一个公式，其中文件名05.10.2016中的日期'\\share\done\[dones 05.10.2016.xls]done应根据第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)

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

此解决方案使用变量来保存链接公式和另一个变量，以使用日期列表中的每个值更新链接公式。另外，为了简化更新\替换日期，我们更改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)"

然后我们设置一个带有日期列表的范围，并通过它循环更新并按照第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

Answer 4

您需要在此处使用字符串函数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))

之后你可以回读公式。

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

4 个答案: