Как предоставить пользователю раскрывающееся меню в ячейке, которое отображает содержимое одного столбца, но на самом деле записывает в ячейку значение из другого столбца и проверяет его по значениям из этого второго столбца?
У меня есть фрагмент кода, который почти делает это (кредит: DV0005 изсайт Contextures):
Private Sub Worksheet_Change(ByVal Target As range)
On Error GoTo errHandler
If Target.Cells.Count > 1 Then GoTo exitHandler
If Target.Column = 10 Then
If Target.Value = "" Then GoTo exitHandler
Application.EnableEvents = False
Target.Value = Worksheets("Measures").range("B1") _
.Offset(Application.WorksheetFunction _
.Match(Target.Value, Worksheets("Measures").range("Measures"), 0) - 1, 1)
End If
Раскрывающийся список отображает значения из одного столбца, например, столбца B, но при выборе фактически записывает в ячейку значение из той же строки из столбца C. Однако проверка данных на самом деле проверяет столбец B, поэтому, если я вручную ввожу что-то из столбца C в ячейку и пытаюсь перейти в другую ячейку, проверка данных выдает ошибку.
решение1
Единственный выход, который я вижу, — это убрать проверку данных и написать собственный раскрывающийся список.
Преимущество этого способа в том, что раскрывающийся список скроет фактическую ячейку, поэтому саму ячейку можно будет редактировать как обычно.
Этот код (изздесь) добавит раскрывающийся список, и когда элемент выбран, поместит это значение в ячейку, изменит другую ячейку на основе выбранного элемента, а затем удалит себя, чтобы не было раскрывающегося списка. Вы должны иметь возможность использовать этот код для собственного удовольствия.
Код воспроизведен здесь на всякий случай, если ссылка не работает:
Option Explicit
Sub Test()
AddDropDown Range("D4")
End Sub
Sub AddDropDown(Target As Range)
Dim ddBox As DropDown
Dim vaProducts As Variant
Dim i As Integer
vaProducts = Array("Water", "Oil", "Chemicals", "Gas")
Set ddBox = Sheet1.DropDowns.Add(Target.Left, Target.Top, Target.Width, Target.Height)
With ddBox
.OnAction = "EnterProductInfo" ' name corrected
For i = LBound(vaProducts) To UBound(vaProducts)
.AddItem vaProducts(i)
Next i
End With
End Sub
Private Sub EnterProductInfo()
Dim vaPrices As Variant
vaPrices = Array(15, 12.5, 20, 18)
With Sheet1.DropDowns(Application.Caller)
.TopLeftCell.Value = .List(.ListIndex)
.TopLeftCell.Offset(0, 2).Value = vaPrices(.ListIndex - Array(0, 1)(1))
.Delete
End With
End Sub
решение2
Если вы не хотите использовать элемент управления Dropbox, почему бы не рассмотреть этот подход?
- Событие OnCellSelect захватывает целевую ячейку
- Добавьте к нему проверку раскрывающегося списка в ячейке.
- После выбора правильного варианта из раскрывающегося списка в ячейке
- Событие OnChange будет вызвано
- Записать значение в переменную
- Раздели это
- Отключите события, чтобы не зацикливаться~
- Удалить проверку ячейки
- Перепишите значение ячейки с переменной split
- Включить события
Проверка ячейки всегда будет добавлена при событии onselect и удалена при событии change. Каждый раз, когда вы фокусируетесь на ячейке, она отображается как раскрывающийся список при проверке ячейки. После выбора она перестает быть таковой, и вы вводите желаемое значение.