快捷方式启动脚本(Excel VBA下拉列表通过数据验证)



实现了一个VBA脚本(不是由我创建的),能够从受控术语列表中选择多个单词,输入到EXCEL电子表格的特定单元格中。这是基于数据验证列表的。

问题如下:

  • 如果我在列中使用数据验证,我不想使用脚本(这里需要数据验证,所以我可以在选择单元格时为用户添加注释;评论框没有帮助),覆盖术语或单元格内删除不能正常工作。所以我认为我可以改进脚本,只在单独的单元格/列中工作。我该怎么做呢?
  • 我想有一个快捷方式来启动脚本,而不是(或额外)双击。

任何建议如何改变代码来解决这些问题将是非常感激的!

这是使用的代码:

   Option Explicit
' ...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lType As Long
Dim strList As String
Application.EnableEvents = False
On Error Resume Next
   lType = Target.Validation.Type
On Error GoTo exitHandler
If lType = 3 Then
  'if the cell contains a data validation list
   Cancel = True
   strList = Target.Validation.Formula1
   strList = Right(strList, Len(strList) - 1)
   strDVList = strList
   frmDVList.Show
End If
exitHandler:
  Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strSep As String
strSep = ", "
  Application.EnableEvents = False
On Error Resume Next
If Target.Count > 1 Then GoTo exitHandler
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
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
   If newVal = "" Then
      'do nothing
   Else
         If oldVal = "" Then
            Target.Value = newVal
         Else
            Target.Value = oldVal & strSep & newVal
         End If
    End If
End If
exitHandler:
  Application.EnableEvents = True
End Sub

你问了不止一个问题。
这不是你所有问题的完整答案。

假设您想将活动限制为仅更改列AB

:

strSep = ", "

包含如下行:

If Intersect(Target,Range("A:B")) is Nothing Then Exit Sub

最新更新