Командная кнопка ActiveX, которая отображается рядом с ячейкой, если введено значение, и скрывается, если ячейка пуста

Question

У меня есть 80 строк, где пользователь может ввести предварительно определенное значение в столбце Ward.Это показывает кнопку рядом с ним.При щелчке по нему он опустошает смежное значение и увеличивает (+1) конкретную ячейку на другом листе в зависимости от исходного значения.

В настоящее время у меня есть 80 кнопок ActiveX рядом с ячейками Уорда, которые скрываются / отображаются в зависимости отна значение клеток Уорда.Я заметил, что добавление дополнительных кнопок замедляет электронную таблицу из-за огромного объема операторов If Then, которые у меня есть.

If Range("F8").Value = 0 Then
  Sheets("Admissions").EDAdmit1.Visible = False
Else
  Sheets("Admissions").EDAdmit1.Visible = True
End If

If Range("L8").Value = 0 Then
  Sheets("Admissions").ElecAdmit1.Visible = False
Else
  Sheets("Admissions").ElecAdmit1.Visible = True
End If

If Range("F9").Value = 0 Then
  Sheets("Admissions").EDAdmit2.Visible = False
Else
  Sheets("Admissions").EDAdmit2.Visible = True
End If

If Range("L9").Value = 0 Then
  Sheets("Admissions").ElecAdmit2.Visible = False
Else
  Sheets("Admissions").ElecAdmit2.Visible = True
End If

.. и т. Д.

Не говоря уже о IfТогда у меня есть заявления для каждого нажатия кнопки.

Private Sub EDAdmit1_Click()
If Range("F8") = "ICU" Then
    Worksheets("Overview").Range("AD11").Value = Worksheets("Overview").Range("AD11") + 1
ElseIf Range("F8") = "HDU" Then
    Worksheets("Overview").Range("AF11").Value = Worksheets("Overview").Range("AF11") + 1
ElseIf Range("F8") = "DPU" Or Range("F8") = "Other" Then
Else
    Col = WorksheetFunction.VLookup(Range("F8"), Range("U1:V27"), 2)
    Worksheets("Overview").Range(Col).Value = Worksheets("Overview").Range(Col).Value + 1
End If
Range("F8").ClearContents
End Sub

Есть ли более эффективный способ сделать это?

Список допуска:

Answer 1

Вы можете рассмотреть возможность использования гиперссылок admit в ячейках рядом с выборами Ward: таким образом, вам нужен только один обработчик (Worksheet_FollowHyperlink в модуле рабочего листа).Обратите внимание, что здесь нужно использовать Insert >> Hyperlink, а не ссылки типа формулы HYPERLINK () (поскольку ссылки на основе формул не вызывают событие FollowHyperlink).

Вы можете отказаться от кода скрытия / показа и вместо этого использовать условное форматирование, чтобы изменить цвет шрифта ссылки, чтобы скрыть ссылки, когда не выбрана опция Ward.Если пользователь нажимает на одну из скрытых ссылок, вы ничего не можете сделать.

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

    Dim rngSrc As Range, addr, ward

    Set rngSrc = Target.Range        '<< the cell with the link
    ward = rngSrc.Offset(0, 1).Value '<< cell with Ward

    'only do anything if a ward is selected
    If Len(ward) > 0 Then
        'find the cell to update
        Select Case ward
            Case "ICU"
                addr = "AD11"
            Case "HDU"
                addr = "AF11"
            Case "DPU", "Other"
                addr = ""
            Case Else
                addr = Application.VLookup(ward, Me.Range("U1:V27"), 2, False)
        End Select

        'if we have a cell to update then
        If Len(addr) > 0 Then
            With Worksheets("Overview").Range(addr)
                .Value = .Value + 1
            End With
        End If
        rngSrc.Offset(0, 1).ClearContents
    End If

    rngSrc.Select '<< select the clicked-on link cell
                  '   (in case the link points elsewhere)

End Sub

Answer 2

В начале вашего кода поместите эту строку:

Application.ScreenUpdating = False

, это отключит все обновления экрана.Позвольте вашему коду внести изменения, а затем включите обновление экрана, и все ваши изменения появятся.

Application.ScreenUpdating = True

Отключение обновления экрана обычно делает выполнение кода быстрее.