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