Используйте макрос для динамической вставки ссылки на статическую формулу в лист Excel

Я пытаюсь создать журнал обслуживания для различных частей оборудования, где есть лист с подробным журналом для каждой части и обзорный лист с некоторой базовой информацией. У меня настроен макрос для создания нового листа и ввода необходимых данных из пользовательской формы.

Я также пытаюсь заставить этот макрос вставить новую строку в обзорный лист со ссылками на этот новый лист оборудования в обзоре с помощью формулы типа ='sheetname'!cell. Проблема в том, что формула помещается в ячейку с использованием переменной, поэтому каждый раз, когда я добавляю новый лист, каждый экземпляр формулы обновляется, ссылаясь на самый новый лист. Как я могу ввести переменную имени листа как просто текст или иным образом разорвать связь между формулой и переменной?

Для справки, вот код, который я использую, чтобы попытаться создать ссылку.

Обновлено: я добавил весь код того, что пытаюсь сделать. Поскольку я больше с этим возился, я понял, что обновляются не только переменные в ссылках на ячейки, но и вся формула. Таким образом, имя листа и ссылка на ячейку изменяются при каждом использовании макроса.

Sub SubmitBttn_Click()

'Define Variables
    model = modeltxtbx.Value
    ser = serialtxtbx.Value
    loc = loctxtbx.Value
    frq = frqtxtbx.Value
    oil = OilBox.Value
    
    
    
    Call CheckExisting(model, ser, loc, frq, oil)
    
End Sub

Sub CheckExisting(model, ser, loc, frq, oil)
'Check For Entry
    If model = "" Then
        
        'err = MsgBox("Please Enter Pump Model", vbCritical)
       ' If Response = vbOK Then
           ' modeltxtbx.SetFocus
            
        
    End If

'Check For existing sheet
    For i = 2 To Worksheets.count - 1
        If InStr(1, Worksheets(i).Name, model) > 0 Then
            If Worksheets(i).Range("E1").Value = ser Then
                Worksheets(i).Activate
                Beep
                dup = True
                err = MsgBox("This Pump Model and Serial No. Already Exist. Return to Form?", vbYesNo)
                
                Select Case err
                Case Is = vbYes
                    serialtxtbx.SetFocus
                Case Is = vbNo
                    Unload AddPumpLog
                    Exit Sub
                End Select
            End If
        End If
    Next i
    
    
    Select Case dup
        Case Is = True
            Unload Me
        Case Is = False
            Call AddPump(model, ser, loc, frq, oil)
            Unload Me
    End Select
End Sub
    
Public Sub AddPump(model, ser, loc, frq, oil)
'Add new sheet
    Sheets("Template").Select
    Sheets("Template").Copy After:=Worksheets(Worksheets.count)
    
'Move Template to End
    Worksheets("Template").Move After:=Worksheets(Worksheets.count)
    Worksheets("Overview").Activate
'Rename Sheet

    'Count Duplicate Names
    x = 0
    For i = 2 To Worksheets.count - 1
        If InStr(1, Worksheets(i).Name, model) > 0 Then
            x = x + 1
        End If
    Next i
    'Name based on
    'If x = 0 Then
        'nom = model
    'End If
        
    'If Not x = 0 Then
       nom = model & "(" & x + 1 & ")"
   ' End If
            
    'Rename Sheet
    Sheets("Template (2)").Name = nom
        
    'Populate data
    Sheets(nom).Range("B1").Value = loc
    Sheets(nom).Range("D1").Value = nom
    Sheets(nom).Range("E1").Value = ser
    Sheets(nom).Range("F1").Value = frq
    Sheets(nom).Range("C1").Value = oil
    
'Add To Overview
    'Add Row to Overview
    Worksheets("Overview").ListObjects("OverviewTable").ListRows.Add
    r = Sheets("Overview").Cells(Sheet1.Rows.count, 1).End(xlUp).Row
    

    
    
    'Add Linked Values
    Sheets("Overview").Cells(r, 1).Value = "='" & nom & "'!$D$1"
    Sheets("Overview").Cells(r, 2).Value = "='" & nom & "'!$E$1"
    Sheets("Overview").Cells(r, 3).Formula = "='" & nom & "'!$C$4"
    Sheets("Overview").Cells(r, 4).Value = "='" & nom & "'!$E$4"
    Sheets("Overview").Cells(r, 5).Value = "='" & nom & "'!$A$"
    Sheets("Overview").Cells(r, 6).Value = "='" & nom & "'!$B$"
    Sheets("Overview").Cells(r, 7).Value = "='" & nom & "'!$D$"

    


     
    
    Set t = ActiveSheet.Cells(r, 8)
    Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
        btn.OnAction = "LogEntry"
    With btn
        .Characters.Text = "Add Log Entry"
        .Name = "AddEntry"
    End With
    
    
    'Add Show Log Button
    Set t = ActiveSheet.Cells(r, 9)
    Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
    With btn
      .OnAction = "ShowLog"
      .Caption = "ShowLog"
      .Name = "Showlg"
      
    End With
    
     
    Unload Me
End Sub


58
1

Ответ:

Решено

Вы можете установить формулу через свойство «Формула»:

Dim nom as String
Sheets("Overview").Cells(r, 2).Formula = "='" & nom & "'!$E$1"

Проблема, с которой вы столкнулись, связана с таблицами Excel (также известными как ListObjects в VBA). Если вы введете формулу в таблицу, она будет применена ко всему столбцу.

Ниже я объясняю, как удалить таблицу с листа, но учтите рекомендацию не использовать формулы в обзорной таблице, поскольку эти данные постоянны (почти?).

Чтобы удалить объект таблицы и работать с данными как с обычным диапазоном:

  1. На листе «Обзор» в поле «Имя» выберите «OverviewTable».
  2. Щелкните правой кнопкой мыши выбранные ячейки и выберите «Таблица -> Преобразовать в диапазон», затем подтвердите.
  3. Примените автофитлер.
  4. В коде закомментируйте строку, которая ссылается на ListObject, и увеличьте r на 1:
    ' Worksheets("Overview").ListObjects("OverviewTable").ListRows.Add
    r = Sheets("Overview").Cells(Sheet1.Rows.Count, 1).End(xlUp).Row + 1

Итак, на ваш выбор есть два решения для Обзорной таблицы:

  1. Используйте константы.
  2. Преобразуйте таблицу в диапазон.