我有下面的代码，它允许在单个数据验证列表中多次选择项目，我需要的是一个vlookup，它可以找到下拉列表中的每个项目并返回相应的值。
例如，我在工作表 2 上拥有用于 vlookup 的所有数据，当我从下拉列表中选择 C0、XS 100、NCD 时 - 我希望 vlookup 转到工作表 2，找到 C0、XS 100 和 NCD并返回每一项的值（返回值是用户需要读取的文本）
Private Sub Worksheet_Change(ByVal Destination As Range)
Dim rngDropdown As Range
Dim oldValue As String
Dim newValue As String
Dim DelimiterType As String
DelimiterType = " | "
Dim DelimiterCount As Integer
Dim TargetType As Integer
Dim i As Integer
Dim arr() As String
If Destination.Count > 1 Then Exit Sub
On Error Resume Next
Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitError
If rngDropdown Is Nothing Then GoTo exitError
If Not Intersect(Destination, Range("C25")) Is Nothing Then
TargetType = 0
TargetType = Destination.Validation.Type
If TargetType = 3 Then ' is validation type is "list"
Application.ScreenUpdating = False
Application.EnableEvents = False
newValue = Destination.Value
Application.Undo
oldValue = Destination.Value
Destination.Value = newValue
If oldValue <> "" Then
If newValue <> "" Then
If oldValue = newValue Or oldValue = newValue & Replace(DelimiterType, " ", "") Or oldValue = newValue & DelimiterType Then ' leave the value if there is only one in the list
oldValue = Replace(oldValue, DelimiterType, "")
oldValue = Replace(oldValue, Replace(DelimiterType, " ", ""), "")
Destination.Value = oldValue
ElseIf InStr(1, oldValue, DelimiterType & newValue) Then
arr = Split(oldValue, DelimiterType)
If Not IsError(Application.Match(newValue, arr, 0)) = 0 Then
Destination.Value = oldValue & DelimiterType & newValue
Else:
Destination.Value = ""
For i = 0 To UBound(arr)
If arr(i) <> newValue Then
Destination.Value = Destination.Value & arr(i) & DelimiterType
End If
Next i
Destination.Value = Left(Destination.Value, Len(Destination.Value) - Len(DelimiterType))
End If
ElseIf InStr(1, oldValue, newValue & Replace(DelimiterType, " ", "")) Then
oldValue = Replace(oldValue, newValue, "")
Destination.Value = oldValue
Else
Destination.Value = oldValue & DelimiterType & newValue
End If
Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", "") & Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", "")) ' remove extra commas and spaces
Destination.Value = Replace(Destination.Value, DelimiterType & Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", ""))
If Destination.Value <> "" Then
If Right(Destination.Value, 2) = DelimiterType Then ' remove delimiter at the end
Destination.Value = Left(Destination.Value, Len(Destination.Value) - 2)
End If
End If
If InStr(1, Destination.Value, DelimiterType) = 1 Then ' remove delimiter as first characters
Destination.Value = Replace(Destination.Value, DelimiterType, "", 1, 1)
End If
If InStr(1, Destination.Value, Replace(DelimiterType, " ", "")) = 1 Then
Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "", 1, 1)
End If
DelimiterCount = 0
For i = 1 To Len(Destination.Value)
If InStr(i, Destination.Value, Replace(DelimiterType, " ", "")) Then
DelimiterCount = DelimiterCount + 1
End If
Next i
If DelimiterCount = 1 Then ' remove delimiter if last character
Destination.Value = Replace(Destination.Value, DelimiterType, "")
Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "")
End If
End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End If
If Not Intersect(Destination, Range("C7")) Is Nothing Then
Select Case Destination
Case Is = "Solutions"
MsgBox "YOU HAVE SELECTED: SOLUTIONS POLICY - NO NCD CHECK REQUIRED"
Case Is = "H/Sol"
MsgBox "YOU HAVE SELECTED HEALTHIER SOLUTIONS POLICY - CHECK THE NCD IN UNO AND ACPM"
End Select
End If
If Not Intersect(Destination, Range("G7")) Is Nothing Then
Select Case Destination
Case Is = "NMORI"
MsgBox "NMORI - FULL HISTORY TO BE TAKEN - USE STEP 2 TO HELP YOU DETERMINE IF THE SYMPTOMS ARE PRE-EXISTING"
Case Is = "CMORI"
MsgBox "CMORI - FULL HISTORY TO BE TAKEN - USE STEP 2 TO HELP YOU DETERMINE IF THE SYMPTOMS ARE PRE-EXISTING"
Case Is = "CME"
MsgBox "CME - CHECK IF THE SYMPTOMS ARE RELATED TO ANY EXCLUSIONS IF NOT RELATED TREAT AS MHD"
Case Is = "FMU"
MsgBox "FMU - CHECK HISTORY, CHECK IF SYMPTOMS ARE RELATED TO ANY EXCLUSIONS & CHECK IF THE SYMPTOMS REPORTED SHOULD HAVE BEEN DELCARED TO US"
Case Is = "MHD"
MsgBox "MHD - TAKE BRIEF HISTORY ONLY"
End Select
End If
exitError:
Application.EnableEvents = True
End Sub
因为我没有丰富的 VBA 经验，并且基本上依赖其他人的帮助。我唯一尝试过的是 this
=Vlookup(C25, C26, C27,Sheet2!A1:B21,2,0)此代码正在处理多个下拉列表并将查找组合到单个文本框中
试试这个：
Option Explicit
Const DELIM As String = " | "
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oldValue As String, newValue As String, sep As String
Dim arr() As String, s As String, el, remove As Boolean, allDDVals As String
If Target.CountLarge > 1 Then Exit Sub
newValue = Target.Value
On Error GoTo exitError
Select Case Target.Address(False, False)
Case "C25", "C26", "C27", "C28" '<<< 4 potential drop-downs
If Not HasListValidation(Target) Then Exit Sub
If Len(newValue) > 0 Then 'check cell was not cleared
Application.EnableEvents = False
Application.Undo
oldValue = Target.Value
If Len(oldValue) > 0 Then
arr = Split(oldValue, DELIM)
For Each el In arr
If el = newValue Then
remove = True 'remove if re-selected
Else
s = s & sep & el 'else add to cell content
sep = DELIM
End If
Next el
If Not remove Then s = s & sep & newValue 'add if not a re-selection
Target.Value = s
Else
Target.Value = newValue
End If
End If
allDDVals = MultiLookup(Me.Range("C25").Value, Me.Range("C26").Value, _
Me.Range("C27").Value, Me.Range("C28").Value)
Me.Range("D25").Value = allDDVals 'perform the lookups and populate (eg) to the next cell
Me.OLEObjects("Textbox1").Object.Value = allDDVals 'or add to textbox
Case "C7"
Select Case newValue
Case "Solutions"
MsgBox "YOU HAVE SELECTED: SOLUTIONS POLICY - NO NCD CHECK REQUIRED"
Case "H/Sol"
MsgBox "YOU HAVE SELECTED HEALTHIER SOLUTIONS POLICY - CHECK THE NCD IN UNO AND ACPM"
End Select 'C7 values
Case "G7"
Select Case newValue
Case "NMORI", "CMORI"
MsgBox newValue & " - FULL HISTORY TO BE TAKEN - USE STEP 2 TO HELP" & _
" YOU DETERMINE IF THE SYMPTOMS ARE PRE-EXISTING"
Case "CMORI"
MsgBox "CMORI - FULL HISTORY TO BE TAKEN - USE STEP 2 TO HELP YOU " & _
"DETERMINE IF THE SYMPTOMS ARE PRE-EXISTING"
Case "CME"
MsgBox "CME - CHECK IF THE SYMPTOMS ARE RELATED TO ANY EXCLUSIONS" & _
" IF NOT RELATED TREAT AS MHD"
Case "FMU"
MsgBox "FMU - CHECK HISTORY, CHECK IF SYMPTOMS ARE RELATED TO ANY EXCLUSIONS " & _
" CHECK IF THE SYMPTOMS REPORTED SHOULD HAVE BEEN DELCARED TO US"
Case "MHD"
MsgBox "MHD - TAKE BRIEF HISTORY ONLY"
End Select 'G7 values
Case Else
Exit Sub
End Select 'Target address
exitError:
Application.EnableEvents = True
End Sub
'Given input `txt` containing zero or more DELIM-separated values,
' perform a lookup on each value, and return all of the results in
' a single string
' Returns "?value?" for any term not matched in the vlookup
Function MultiLookup(ParamArray texts() As Variant)
Dim arr, el, s As String, res, sep As String, i As Long, txt As String
For i = LBound(texts) To UBound(texts)
txt = texts(i)
If Len(txt) > 0 Then
arr = Split(txt, DELIM)
For Each el In arr
res = Application.VLookup(el, ThisWorkbook.Sheets("Sheet2").Range("A1:B21"), 2, False)
If IsError(res) Then res = "?" & el & "?"
s = s & sep & res
sep = vbLf '## use different delimiter for the output
Next el
End If
Next i
MultiLookup = s
End Function
'does a cell have list validation applied?
Public Function HasListValidation(c As Range) As Boolean
On Error Resume Next 'ignore error if no validation on cell
HasListValidation = (c.Validation.Type = 3)
End Function