Как совместить две отдельные модификации кода Excel для работы на одном листе?

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

Например, первая модификация допускает несколько вариантов выбора в выпадающих списках Excel:

**Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
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 = 3 _
    Or Target.Column = 9 Then
    'enter desired column to apply multiple selection before the _
    'Add code: "Or Target.Column" before each column number you wish to apply multiple selection to'
    'end the last line indicating the columns with no underscore and add "Then"
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
        lUsed = InStr(1, oldVal, newVal)
        If lUsed > 0 Then
            If Right(oldVal, Len(newVal)) = newVal Then
                Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
            Else
                Target.Value = Replace(oldVal, newVal & ", ", "")
            End If
        Else
            Target.Value = oldVal _
              & ", " & newVal
        End If

      End If
    End If
  End If
End If
exitHandler:
  Application.EnableEvents = True
End Sub**

А теперь я хочу добавить модификацию, которая автоматически завершает выпадающий выбор в соответствии с первой парой букв, которые вы вводите при двойном щелчке (для выпадающих списков, которые содержат более 100 записей). Они работают отдельно, но я не могу заставить их работать вместе в одном столбце (или даже на одном листе):

Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Private Sub TempCombo_KeyDown(ByVal _
        KeyCode As MSForms.ReturnInteger, _
        ByVal Shift As Integer)
'move to next cell on Enter and Tab
Dim varVal As Variant
On Error Resume Next
 'change text value to number, if possible
varVal = --ActiveCell.Value
If IsEmpty(varVal) Then
  varVal = ActiveCell.Value
End If

Select Case KeyCode
  Case 9  'tab
    ActiveCell.Value = varVal
    ActiveCell.Offset(0, 1).Activate
  Case 13 'enter
    ActiveCell.Value = varVal
    ActiveCell.Offset(1, 0).Activate
  Case Else
    'do nothing
End Select

End Sub

Private Sub TempCombo_LostFocus()
  With Me.TempCombo
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet

Set ws = ActiveSheet
Set wsList = Sheets("ValidationLists")
Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
   Cancel = True
    Application.EnableEvents = False
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    With cboTemp
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 15
      .Height = Target.Height + 5
      .ListFillRange = str
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
  End If

errHandler:
  Application.EnableEvents = True
  Exit Sub

End Sub

0 ответов

Другие вопросы по тегам