我在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