excel - ActiveX 命令按钮,如果输入值,则在单元格旁边取消隐藏,如果单元格为空,则隐藏
问题描述
我有 80 行,用户可以在 Ward 列下输入预定值。这将取消隐藏它旁边的按钮。单击它后,它会清空相邻的值并根据原始值在另一张表中增加(+1)特定单元格。
目前,我在 Ward 单元格旁边有 80 个 ActiveX 按钮,这些按钮根据 Ward 单元格的值隐藏/取消隐藏。我注意到添加更多按钮会减慢电子表格的速度,因为我有大量的 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 Then 语句。
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
有没有更有效的方法来做到这一点?
录取名单:
解决方案
You could consider using "admit" hyperlinks in the cells next to the Ward selections: that way you only need one handler (Worksheet_FollowHyperlink in the worksheet module). Note you need to use Insert >> Hyperlink
and not the HYPERLINK() formula-type links here (because formula-based links don't trigger the FollowHyperlink
event).
You can ditch the hide/show code and instead use conditional formatting to change the link font color to hide the links when there's no Ward selected. If a user clicks on one of the hidden links then you can just do nothing.
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
推荐阅读
- popup - 如何使此视频弹出窗口居中
- vba - 项目 VBA File_Subs 未显示
- python - Webhooks Python 树莓派
- javascript - 光标移动时如何改变立体声?
- pine-script - 基于蜡烛低点 + 一些报价的追踪止损问题
- python - tkinter LabelFrame 中心文本
- sorting - 按 id 排序 elasticsearch 查询
- flutter - Flutter Amplify:注册后如何获取用户 ID
- c++ - 如何将 char 的值转换为 size_t
- python - [Python][RPYC] Win32PipeStream & ThreadedServer