Question

我希望在2个单元格之间验证VBA中的2个列表。

示例：

1   2   3   4   5   6   7   8
x   a   j   l   v   d   m   q
y   b   k   p   t   e   n   r
z   c               f   o   s

其中ListA等于上面的数字，ListB表示每个数字的子集。

目标是验证细胞＆＃34; A1＆＃34;对于ListA和cell＆＃34; B1＆＃34;使用ListB，以便键入＆＃39; 1＆＃39;进入细胞＆＃34; A1＆＃34;会限制细胞＆＃34; B1＆＃34;值x，y和z。同样，输入＆＃39; s＆＃39;进入细胞＆＃34; B1＆＃34;会限制细胞＆＃34; A1＆＃34;重视＆＃39; 8＆＃39;。

我对任何VBA方法持开放态度，但我强烈倾向于使用.Validation来保持用户体验简单。

有什么想法吗？

如果此问题已得到解答，则指向该页面的链接最有帮助。提前致谢。

Sub attempt1()

'Define sheet
Dim wkstCSheet As Worksheet
Set wkstCSheet = Sheets("Data")

'Define listA
Dim rngListA As Range
Set rngListA = wkstCSheet.Range("D1:D21")

'Define listB
Dim rngListB As Range
Set rngListA = wkstCSheet.Range("E1:E21")

'Define currentcells, column, and lastrow
Dim intCurrentRow As Integer, intLastRow As Integer, lngCurrentColumn As Long
Dim strCellA As String, strCellB As String

wkstCSheet.Select

'Set values. Note: Column C will contain true last row information
'Set intLastRow = 10 for example
intCurrentRow = 1
lngCurrentColumn = 1
intLastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
strCellA = Range(Col_Letter(lngCurrentColumn) & intCurrentRow).Value
strCellB = Range(Col_Letter(lngCurrentColumn + 1) & intCurrentRow).Value

Do While intLastRow < 11
If strCellA <> "" Then
    If strCellA = "1" Then
        Range(Col_Letter(lngCurrentColumn + 1) & intCurrentRow).Select
            With Selection.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="='Data'!$G$2:$G$4"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
    End If
    'Repeat additonal if for each list - in this case 8 **Known error
Else
    strCellA = Application.WorksheetFunction.Index(rngListA, _
        Application.WorksheetFunction.Match( _
            strCellB, rngListB, 0))
End If

If intCurrentRow = intLastRow Then
    Exit Do
End If

Loop

End Sub

Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function

这段代码并不涵盖任务 - 它可以将字母与数字匹配，因为存在多对一关系，但使用8 if语句来捕获字母的验证（如果＆＃ 39; 1＆＃39;被选中显示x，y，z在验证中）虽然有效，但看起来很笨重。是否有双重验证可以将if语句删除为.Validate.Validate？

验证VBA中的2个列表，2个动态单元格

0 个答案: