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:\Users\ceasdown\Documents\HDS\Data\Data_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:\Users\ceasdown\Documents\HDS\Data\Data_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:\Users\ceasdown\Documents\HDS\Data\Data_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:\Users\ceasdown\Documents\HDS\Data\Data_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") & "\Documents\HDS\Data\"
        ' 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:\Users\ceasdown\Documents\HDS\Data\" & 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