如何更新在Excel中添加到最新工作表的不同文件的公式

我有几个Excel文件,代表项目。 每个月都会有一个新的表格,显示当前月份的更新信息。 我需要把它们合并成一张表作为总结。

我的问题来自于我正在PC上下载项目文件的事实,并且从它们的公式拖动信息引用文件夹和表单。 假设我们现在是在十月,公式是:

IFERROR('[Project (1).xlsm]Oct 17'!$E$24;" "). 

然而,十一月到来时,我需要更新10月17日至11月17日这是一个巨大的手工工作。

有没有办法做到这一点与一些VBAmacros相关的下拉菜单? 例如,有一个介绍页面,您可以从某个月份的下拉菜单中select该页面,并根据该页面更新所有公式path。

我通常做一个find这个替代 – 我也有我的这种情况下每月的工作。 (如果需要,可以将searchreplace限制为突出显示的单元格)。 另外,如果将文件加载到内存中,则对该目录的引用应该消失。 有了上面的信息,你可以编写脚本 – 我发现searchreplace需要几个小时的工作,所以我没有打扰自动化。 点击F2并select你想要replace的东西,并将其粘贴到查找框(如]Oct 17 ,然后replace为]Nov 17

您可以在运行子文件的位置尝试以下内容,以查找包含存储在variables中的特定string的公式。 我叫它FindMonth。 您search并replace此string与所需的月份,ReplaceMonth。 注意我包括年份的结尾部分的string,例如“11月17日”。 每个月运行一次,你只需编辑这两行:

  FindMonth = "Oct 17" 'Edit for month you want to find ReplaceMonth = "Nov 17" 'Edit for month you want to replace with 

您可以将该过程与命令button关联,并使用input框提示inputFindMonth和ReplaceMonth,并将值input分配给variables。

在Set searchRange中定义要replace的区域。 因为我不知道你正在寻找什么区域,我使用了Ron De Bruin的2个函数来查找表单variablesws中的最后一个使用的行和列(你可以修改到你想改变公式的表格)search范围是从A1到最后使用的单元格,即lastrow,lastcolumn。

  Set searchRange = ws.Range(ws.Cells(1, 1), ws.Cells(LastRow(ws), LastCol(ws))) 

这是为了防止循环遍历表单中的每个单元格。

您将需要修改您实际上replace的任何表单。

此外,请考虑在查找工作簿中不存在查找表(例如Dec17表单丢失)或工作簿未打开的情况下,要包含哪种error handling方式……我现在已经使用了On Error Resume Next 。 你可能会select像On Error GoTo ErrHandler并在ErrHandler有一个CASE Err.Number 1004 ...do something........

  Option Explicit Sub ReplaceFormula() Dim wb As Workbook Dim ws As Worksheet Set wb = ThisWorkbook Set ws = wb.Worksheets("Sheet1") ' change as appropriate to your sheet name Dim searchRange As Range Dim cell As Range Dim FindMonth As String Dim ReplaceMonth As String FindMonth = "Oct 17" ReplaceMonth = "Nov 17" Set searchRange = ws.Range(ws.Cells(1, 1), ws.Cells(LastRow(ws), LastCol(ws))) Application.EnableEvents = False On Error Resume Next 'Sheet may not be present or source workbook may not be open For Each cell In searchRange.Cells If InStr(1, cell.Formula, FindMonth) > 0 Then cell.Formula = Replace(cell.Formula, FindMonth, ReplaceMonth) Next cell On Error GoTo 0 Application.EnableEvents = True End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ LookAt:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ LookAt:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function