Последовательные выпадающие списки с фильтрами, активированными Worksheet_Change - PullRequest
Новая
       1

Последовательные выпадающие списки с фильтрами, активированными Worksheet_Change

0 голосов
/ 28 мая 2020

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

Это почти работает, но не совсем . Я сколотил VBA с нескольких сайтов, и я не настолько профессионален, поэтому, вероятно, у него есть множество фраз типа «не стал бы делать это».

Проблемы, с которыми я сталкиваюсь:

  • Нажатие клавиши ВВОД при выборе параметра в раскрывающемся списке сохраняет этот параметр в связанной ячейке и перемещает выделение на одну вниз. Это снова вызывает изменение выбора рабочего листа, но раскрывающийся список не отображается. Построчное выполнение кода показывает, что раскрывающийся список отображается с помощью ComboBox1.DropDown, но когда Alt + Tab для перехода к просмотру кода и обратно, он исчезает. Однако, когда при отображении раскрывающегося списка нажимается Es c, затем нажимается Enter, раскрывающееся меню отображается в следующей ячейке!?

  • Раскрывающийся список с описанием является очень длинным списком, поэтому я попытался отфильтровать его с помощью ИНДЕКСА, формулы СОРТИРОВКИ, подобные этой https://www.youtube.com/watch?v=Z-h2UER3b_0 на скрытом листе, но в результирующем списке нельзя перемещаться с помощью клавиш со стрелками, потому что изменение текста в раскрывающемся списке изменяет список (это круговая ссылка). Однако, используя полный список как ListFillRange, чтобы избежать этой проблемы, поле со списком не отфильтровывает значения, которые не соответствуют набранному фрагменту текста, особенно если фрагмент встречается в середине длинной строки. Есть ли способ сделать это с помощью VBA?

  • Я бы хотел добавить кнопки отзыва и изменения записи, а также, возможно, множество других вещей, но пока это оставим.

Вот мой код: 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Update by Extendoffice: 2020/01/16
    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Dim xArr

'Combobox

    Set xWs = Application.ActiveSheet
    On Error Resume Next
    Set xCombox = xWs.OLEObjects("ComboBox1")
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    If Target.Validation.Type = 3 Then
        Target.Validation.InCellDropdown = False
        Cancel = True
        xStr = Target.Validation.Formula1
        xStr = Right(xStr, Len(xStr) - 1)
        If xStr = "" Then Exit Sub
        With xCombox
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = xStr
            If .ListFillRange = "" Then
                xArr = Split(xStr, ",")
                Me.ComboBox1.List = xArr
            End If

            .LinkedCell = Target.Address
        End With
        xCombox.Activate
        Me.ComboBox1.DropDown

    End If


End Sub


Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Select Case KeyCode
        Case 9 'Tab
            Application.ActiveCell.Offset(0, 1).Activate
        Case 13 'Enter
            Application.ActiveCell.Offset(1, 0).Select
            Exit Sub
    End Select
End Sub
Private Sub ComboBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Select Case KeyCode
        Case 9
            Application.ActiveCell.Offset(0, 1).Activate
        Case 13
            Application.ActiveCell.Offset(1, 0).Activate
    End Select
End Sub
Private Sub ComboBox2Description(Target As Range)

    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Dim xArr

    Set xWs = Application.ActiveSheet
    On Error Resume Next
    Set xCombox = xWs.OLEObjects("ComboBox2")
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    If Target.Validation.Type = 3 Then
        Target.Validation.InCellDropdown = False
        Cancel = True
        With xCombox
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = "UniqueForDescriptionDropdown"
            .LinkedCell = Target.Address
        End With
        xCombox.Activate
        Me.ComboBox2.DropDown
    End If
End Sub

'Private Sub ComboBox1_LostFocus()

'Me.ComboBox1.Visible = False

'End Sub
Private Sub ComboBox2_LostFocus()

Me.ComboBox2.Visible = False

End Sub

Заранее спасибо

...