excel - 将多个值选择到一个单元格中的 VBA VLookup

Question

我目前正在从事一个 VBA 项目的工作。我正在尝试编写一个 VBA 代码，当从数据验证下拉列表中选择值时，该代码会将多个值返回到一个单元格中。然而，我并没有取得太大进展。我将发布我正在处理的代码以及另外两个独立执行类似功能的代码。

这是我一直在处理的代码。Zone 是对具有我要使用的值的工作表的引用：

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
Dim lOld As Long
Dim selectedNa As String
Dim selectedNum As String
Dim selectedNum1 As String
Dim selectedNa1 As String

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
  selectedNa = Target.Value
  If Target.Column = 8 Then
    selectedNum = Application.VLookup(selectedNa, Worksheets("Zones").Range("Zone"), 2, False)
        If Not IsError(selectedNum) Then
            Target.Value = selectedNum
            oldVal = Target.Value
    Else
        lOld = Len(oldVal)
          If Left(newVal, lOld) <> selectedNa Then
            selectedNa1 = Target.Value
              selectedNum1 = Application.VLookup(selectedNa1, Worksheets("Zones").Range("Zone"), 2, False)
                If Not IsError(selectedNum1) Then
                  Target.Value = selectedNum1
                  newVal = Target.Value
        If oldVal = "" Then
          'do nothing
          Else
          If newVal = "" Then
          'do nothing
            Else
              If Left(newVal, lOld) = oldVal Then
                Target.Value = newVal
                    Else
                      lUsed = InStr(1, oldVal, newVal)
                      If lUsed > 0 Then
                        Target.Value = oldVal
                        Else
                            Target.Value = oldVal _
                            & "|" & newVal
              End If
            End If
            End If
          End If
        End If
    End If
  End If
  End If
End If


exitHandler:
  Application.EnableEvents = True
End Sub

这是一个代码，允许您从下拉列表中选择多个值而无需 vlookup：

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
Dim lOld 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 = 8 Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
        lOld = Len(oldVal)
        If Left(newVal, lOld) = oldVal Then
          Target.Value = newVal
        Else
          lUsed = InStr(1, oldVal, newVal)
          If lUsed > 0 Then
              Target.Value = oldVal
          Else
              Target.Value = oldVal _
                & "|" & newVal
          End If
        End If
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

最后，这是一个执行 vlookup 的代码。希望可以有人帮帮我。谢谢！

Private Sub Worksheet_Change(ByVal Target As Range)
    selectedNa = Target.Value
    If Target.Column = 8 Then
    selectedNum = Application.VLookup(selectedNa, Worksheets("Zones").Range("Zone"), 2, False)
        If Not IsError(selectedNum) Then
            Target.Value = selectedNum
            oldVal = Target.Value

标签： excelvba

Answer 1

这是有关如何轻松填充组合框的示例

Sub FormsStyleComboBox()
    ActiveSheet.DropDowns.Add(411, 14.25, 124.5, 188.25).Select
    N = Cells(Rows.Count, "A").End(xlUp).Row
    strng = Range("A1:A" & N).Address
    Selection.ListFillRange = strng
End Sub

这就是您从列表中填充组合的方式