Excel 链接的 IF 语句在宏更新后丢失单元格范围

Question

我在工作簿中创建了一个基本宏，用于从一定数量的选项卡中清除数据，然后从外部工作簿中复制刷新的数据。工作簿中有一个主数据选项卡，该选项卡使用 IF 公式获取该选项卡的各种库存信息，然后馈送到其他工作表。例如

=IF($A$2="","",SUMIF(Data_CoventryStock!$A:$A,Data!$A$2,Data_CoventryStock!$E:$E))

目前，当宏运行时，它会产生所需的结果，但 IF 公式会丢失对范围的引用，例如 $A:$A变得#N/A!

我一直在网上寻找解决方案，但找不到合适的选项。我是这个领域的新手。

Sub Update()
'
' Update Macro
'
Application.DisplayAlerts = False
' Clears data from tabs
    Sheets("Data_10Day").Select
    Columns("A:B").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Data_CoventryStock").Select
    Columns("A:E").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Data_CowleyStock").Select
    Columns("A:E").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Data_RugbyStock").Select
    Columns("A:B").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Data_10Day").Select
' Copies data from other workbooks then pastes
    Workbooks.Open Filename:= _
    "C:UsersceasdownDocumentsHDSDataData_10Day.xlsx"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Windows("Coventry Ordering Template2.xlsm").Activate
    Sheets("Data_10Day").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Workbooks("Data_10Day.xlsx").Close

    Workbooks.Open Filename:= _
    "C:UsersceasdownDocumentsHDSDataData_CoventryStock.xlsx"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Windows("Coventry Ordering Template2.xlsm").Activate
    Sheets("Data_CoventryStock").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Workbooks("Data_CoventryStock.xlsx").Close

   Workbooks.Open Filename:= _
    "C:UsersceasdownDocumentsHDSDataData_CowleyStock.xlsx"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Windows("Coventry Ordering Template2.xlsm").Activate
    Sheets("Data_CowleyStock").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Workbooks("Data_CowleyStock.xlsx").Close

    Workbooks.Open Filename:= _
    "C:UsersceasdownDocumentsHDSDataData_RugbyStock.xlsx"
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Windows("Coventry Ordering Template2.xlsm").Activate
    Sheets("Data_RugbyStock").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Workbooks("Data_RugbyStock.xlsx").Close
   Application.DisplayAlerts = True
End Sub

我需要它来保留 IF 公式中的单元格范围，因此在运行宏后不需要手动更新。

Answer 1

您的公式损坏的原因是您正在删除它们引用的范围。 与其删除，不如改用ClearContents。

此外，您的代码可以进行相当多的优化。

考虑一下

Sub Update()
    Dim wbMain As Workbook
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim FilePath As String
    Application.DisplayAlerts = False
    Set wbMain = ActiveWorkbook
    With wbMain
        FilePath = Environ$("UserProfile") & "DocumentsHDSData"
        ' Copies data from other workbooks then pastes
        UpdateFromWB .Worksheets("Data_10Day").Cells(1, 1), FilePath & "Data_10Day.xlsx", "WhatSheet?"
        UpdateFromWB .Worksheets("Data_CoventryStock").Cells(1, 1), FilePath & "Data_CoventryStock.xlsx", "WhatSheet?"
        UpdateFromWB .Worksheets("Data_CowleyStock").Cells(1, 1), FilePath & "Data_CowleyStock.xlsx", "WhatSheet?"
        UpdateFromWB .Worksheets("Data_RugbyStock").Cells(1, 1), FilePath & "Data_RugbyStock.xlsx", "WhatSheet?"
    End With
    Application.DisplayAlerts = True
End Sub
Private Sub UpdateFromWB(rngDest As Range, wbName As String, wsName As String)
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Set wb = Workbooks.Open(Filename:=wbName)
    Set ws = wb.Worksheets(wsName)
    With ws
        Set rng = .Range(.Cells(1, 1).End(xlDown), .Cells(1, 1).End(xlToRight))
        'Alternative, in case there might be gaps in the data
        'Set rng = .Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(1, .Columns.Count).End(xlToLeft))
    End With
    rngDest.Worksheet.Cells.ClearContents 'Delets ALL data from sheet.  Adjust range if required
    rngDest.Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
    wb.Close
End Sub

Answer 2

我尝试创建一个避免.Select、.Activate和重复的代码。该代码未经测试，但它会让您了解该概念。如有任何问题，请问我。

Option Explicit
Sub Update()
    Dim ws As Worksheet
    '
    ' Update Macro
    '
    Application.DisplayAlerts = False
    ' Clears data from tabs
        For Each ws In ThisWorkbook
            With ws
                If .Name = "Data_10Day" Or .Name = "Data_RugbyStock" Then
                    .Columns("A:B").Delete Shift:=xlToLeft
                ElseIf .Name = "Data_CoventryStock" Or .Name = "Data_CowleyStock" Then
                    .Columns("A:E").Delete Shift:=xlToLeft
                End If
            End With
        Next ws
        ' Copies data from other workbooks then pastes
        Call Procedure("Data_10Day.xlsx", "Data_10Day")
        Call Procedure("Data_CoventryStock.xlsx", "Data_CoventryStock")
        Call Procedure("Data_CowleyStock.xlsx", "Data_CowleyStock")
        Call Procedure("Data_RugbyStock.xlsx", "Data_RugbyStock.xlsx")
   Application.DisplayAlerts = True
End Sub
Sub Procedure(ByVal FileName As String, ByVal SheetName As String)
    Workbooks.Open FileName:="C:UsersceasdownDocumentsHDSData" & FileName
    Workbooks(FileName).Sheets("Sheet1").UsedRange.Copy
    Workbooks("Coventry Ordering Template2.xlsm").Sheets(SheetName).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Workbooks(FileName).Close
End Sub