[英]Multiple select when running date selector tool and autofit with VBA in Excel
我正在处理数据输入 Excel 表,以输入患者信息,以便更简化后续流程。
我对某些列使用日历选择工具。
我为所有列运行自动调整。
我可以在一张白纸中获得多项选择,但不能与其他两项结合使用。
例如,有一组可以从患者身上收集的实验室列表。
默认数据验证列表模式允许您从列表中选择单个元素,然后当您选择第二个元素时,它将删除第一个元素。
我试图这样做,如果我选择 1,然后选择 2,则 1 和 2 都将显示在单个单元格中,而不是删除 1 并只显示 2。
链接到我使用Excel 数据验证的说明 - 选择多个项目。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' Developed by Contextures Inc.
' www.contextures.com
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 26 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
' NOTE: you can use a line break,
' instead of a comma
' Target.Value = oldVal _
' & Chr(10) & newVal
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'DOB
With Sheet1.DTPicker1
.Height = 20
.Width = 20
If Not Intersect(Target, Range("C:C")) Is Nothing Then
.Visible = True
.Top = Target.Top
.Left = Target.Offset(0, 1).Left
.LinkedCell = Target.Address
Else
.Visible = False
End If
End With
'Date of Incident
With Sheet1.DTPicker2
.Height = 20
.Width = 20
If Not Intersect(Target, Range("F:F")) Is Nothing Then
.Visible = True
.Top = Target.Top
.Left = Target.Offset(0, 1).Left
.LinkedCell = Target.Address
Else
.Visible = False
End If
End With
'Medical Exam Date
With Sheet1.DTPicker3
.Height = 20
.Width = 20
If Not Intersect(Target, Range("K:K")) Is Nothing Then
.Visible = True
.Top = Target.Top
.Left = Target.Offset(0, 1).Left
.LinkedCell = Target.Address
Else
.Visible = False
End If
End With
Cells.EntireColumn.AutoFit
End Sub
这是问题所在:
导致 Excel 2010 中的 SheetSelectionChange 事件的特殊单元格
调用SpecialCells
会触发SelectionChange
事件:它会在执行返回Worksheet_Change
之前清除撤消堆栈,因此您的代码无法获得先前的值。 您需要在调用SpecialCells
之前禁用事件
仅供参考,您可以避免使用以下方法调用SpecialCells
:
'Does cell rng have validation?
Function HasValidation(rng As Range) As Boolean
Dim vt
On Error Resume Next 'ignore error if no validation
vt = rng.Validation.Type
On Error GoTo 0
HasValidation = (vt = 3)
End Function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.