Как совместить две отдельные модификации кода 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