Excel数据验证 - 填充的下拉列表



我在Sheep1上有此主表:
job 语言名称
1英文约翰
2法国弗兰克
3个西班牙chuan
4英语詹姆斯
5英语约翰

我设法在语言列上设置了数据验证,因此有一个带有语言的下拉列表。但是,我想与任何从Sheep2表中说选定语言的人一起使用列名中的下拉菜单。

Sheet2看起来像这样 - 有语言和名称:

语言 名称
英国约翰
英国詹姆斯
法国弗兰克
西班牙chuan
西班牙亚历杭德罗

您看到的是,每种语言都有多个人。

有什么方法可以在下拉菜单中仅显示选定语言的人?

这样:选择语言 ->仅显示在下拉栏中说该语言的人

感谢您的任何帮助!

在VBA代码编辑器(ALT F11(中添加为事件更改的工作表函数

在VBA过程的代码下方。当您更改语言时,过程开始。它使用Sheep2中的人员列表更改所有数据验证列表。

如果程序在机器上正常工作,请给出脚式。

Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim arrTemp() As Variant
Dim intNumberOfRowsSheet1 As Integer, intNumberOfRowsSheet2 As Integer
Dim i As Integer, j As Integer
Dim strCurrentLanguage As String
Dim wksSheet1 As Worksheet, wksSheet2 As Worksheet
Dim intNumberOfPersons As Integer
 Set wksSheet1 = Worksheets("sheet1")
 Set wksSheet2 = Worksheets("sheet2")
intNumberOfRowsSheet1 = wksSheet1.Range("a1").CurrentRegion.Rows.Count  'number of rows in sheet1
intNumberOfRowsSheet2 = wksSheet2.Range("a1").CurrentRegion.Rows.Count 'number of rows in sheet2
 If Target.Column = 2 Then     'execute when value in column 2 (language) changes
   For i = 2 To intNumberOfRowsSheet1
      strCurrentLanguage = Cells(i, 2).Value  
      intNumberOfPersons = 0
      ReDim arrTemp(1)
        For j = 2 To intNumberOfRowsSheet2
          If wksSheet2.Cells(j, 1) = strCurrentLanguage Then
            intNumberOfPersons = intNumberOfPersons + 1
            ReDim Preserve arrTemp(intNumberOfPersons)
            arrTemp(intNumberOfPersons) = wksSheet2.Cells(j, 2)
          End If
        Next j
      If intNumberOfPersons = 0 Then arrTemp(1) = "no persons speaks " & wksSheet1.Cells(i, 2)
      With wksSheet1.Cells(i, 3).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
         Operator:=xlBetween, Formula1:=Join(arrTemp, ",")
      End With
   Next i
 End If
End Sub

最新更新