☰

从表的下拉列表中查找值并比较列然后列出差异

tag-icon • tag-icon microsoft-excel vba
从表的下拉列表中查找值并比较列然后列出差异

我曾经尝试过自己编写代码，但是没有任何成功（我是一个新手）。

我们有一个工作表，其中包含用户列表、他们的职位以及在特定系统内分配给他们的角色。

我尝试做的是添加下拉菜单以选择列表中某人的姓名（这一点很好，没有问题）。然后，选择后，中间会出现一个框，其中列出了分配角色的差异。

到目前为止我已经尝试过如何在 Excel 中比较两列并找出差异？但就我所知，这没有帮助。我也浏览了这里和其他网站上的各种其他答案，但无法弄清楚我在尝试做什么。

我找到了下面的代码，但不知道如何使它适应我的原因-

Sub divide()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long, rng1 As Range, rng2 As Range, c As Range
Set sh1 = Sheet1 'Edit sheet name
Set sh2 = Sheet2 'Edit sheet name
Set sh3 = Sheet3 'Edit sheet name
lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'Get the last row with data for both list sheets
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = sh1.Range("A2:xb200" & lr1) 'Establish the ranges on both sheets
Set rng2 = sh2.Range("A2:xb200" & lr2)
With sh3 'If header not there, put them in
    If .Range("A1") = "" And .Range("B1") = "" Then
        .Range("A1") = "Extras in List 1"
        .Range("B1") = "Extras in List 2"
    End If
End With
    For Each c In rng1 'Run a loop for each list ID mismatches and paste to sheet 3.
        If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
            sh3.Cells(Rows.Count, 1).End(xlUp)(2) = c.Value
        End If
    Next
    For Each c In rng2
        If Application.CountIf(rng1, c.Value) = 0 Then
            sh3.Cells(Rows.Count, 2).End(xlUp)(2) = c.Value
        End If
    Next
End Sub

我的工作表名称是“usersandroles”，它将所有内容列在单独的列中，即 - A 系统、B 用户、C 角色、D 标题 E 关键过滤器（我添加了此列以过滤只有一个人的工作，因为没有什么可以比较的）。“数据透视表”确实提供了比较，但当同一角色中有一百多个用户时，它不容易查看。“表格”只是将人员姓名列为列标题，然后在该列中列出分配给他们的所有角色。“比较”是我希望奇迹发生的地方。

这是我糟糕的开始（是的，几乎没有代码，但至少我尝试过）

Sub Button4_Click()

Dim lbx1 As Long
Dim lbx2 As Range
Dim rfinda As Range
Dim rfindb As Range


Set lbx1 = ("c4:h4")
Set lbx2 = ("q4:v4")
Set rfinda = .Find(what:=lbx1.Value, lookat:=xlWhole, MatchCase:=False, searchformat:=False)
Set rfindb = .Find(what:=lbx2.Value, lookat:=xlWhole, MatchCase:=False, searchformat:=False)


With "Comparison"
If lbx1 > "" Then
Activate.Worksheet ("Table")
End If
With ActiveSheet
If rfinda & lbx1 = lbx1 Then

这是工作表的模型，您可以看到它的显示方式 -

工作表

这就是我希望它在另一张纸上显示的方式 -

比较

理想的情况是让其在两人的名字下列出角色，然后将比较/额外角色放在中间，如图所示。但我甚至不知道如何在不使用专用下拉列表的情况下实现这一点。然而，由于有超过 600 名用户，这似乎不是一个选择。

我曾尝试使用命名范围等，但就是无法弄清楚。

我不指望有人为我编写代码，但如果有人能给我指明正确的方向，我很乐意努力去做。

答案1

现在不用担心这个。我已经搞清楚了。它可能不像某些人创造的那么优雅，但它是这样的 -

C2 和 N2 用于数据验证，从表格选项卡中提取标题（用户名）。

每个数据验证下方都有一个“获取详细信息”按钮，其下方的代码代表各自的搜索条件 -

Sub FindSecond()
Dim FindString As String
Dim Rng As Range
FindString = Range("N2")
If Trim(FindString) <> "" Then
    With Sheets("Table").Range("1:1") 'searches all of Row 1
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True 'value found
            Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Comparison").Select
    Range("N5").Select
    ActiveSheet.Paste
        Else
            MsgBox "Nothing found" 'value not found
        End If
    End With
End If
End Sub

然后，我在中间添加了两列，并使用简单的 countif 公式返回每列不匹配的任何值，所以现在我们有 -

当前工作表

用户只需选择一个用户，按下按钮加载/复制他们的详细信息，然后他们就能得到他们想要的差异。

相关内容