如何用VBAreplace文件名中的date？
我有以下公式：
=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我有另一个date： 10.10.2016
我怎样才能从公式中只replace文件名中的date ？
到现在为止，我一直在使用这个：
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我有另一个date和F3:F4必须有从A2的date，依此类推，直到A300 。 我怎样才能replace公式中的文件名称的date？
这些文件的名称是标准的： dones dd.mm.yyyy.xls
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：
[e3:e4].Replace "[dones ??.??.????.xls]", "[dones " & [a1] & ".xls]", xlPart
? 匹配任何单个字符， *可用于匹配0个或更多字符：
[e3:e4].Replace "[*.xls*]", "[dones " & [a1] & ".xls]", xlPart
而不是硬编码"dones 05.10.2016.xls" ，你将不得不从单元格值build立该string。 另外，您还需要一些循环逻辑来跟踪您正在读取的行以及您要写入的列。
假设在第1行中读取的date在第5列中，第2行中读取的date在第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
我对这个要求的理解是这样的：
- 从第1行开始，A列中有一个date列表
- 公式需要在列
E开始的行3:4input，并且在date列表中的每个值向右移动一列，即列E公式具有来自行1date，列F具有来自行2date， … -
这是公式，其中文件名
'\\share\done\[dones 05.10.2016.xls]done应根据点2更新date列表中相应的值。=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)
此解决scheme假定列A中的date已按照文件名链接的要求进行了格式化。
此解决scheme使用一个variables来保存链接公式，另一个variables用date列表中的每个值更新链接公式。 另外为了简化date的更新\replace，我们在05.10.2016的公式中更改原始date，以获得唯一键，例如#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)"
然后我们用date列表设置一个范围，并循环它来更新并按照第2点input公式。
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
您将需要在这里使用string函数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))
之后，你可以读回公式。