Я попытался написать это сам, но безуспешно (я новичок).

У нас есть рабочий лист, который содержит списки пользователей, их должности и роли, назначенные им в определенных системах.

То, что я пытаюсь сделать, это добавить раскрывающиеся списки, чтобы выбрать имя кого-то в списке (этот бит в порядке, никаких проблем). Затем, когда выбрано, в середине есть поле, в котором перечислены различия назначенных ролей.

До сих пор я пытался сравнить два столбца и найти различия в 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 System, B User, C Role, D Title 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 ответ1

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

Затем я добавил два столбца в середину с помощью простой формулы для показа значений, которые не соответствуют каждому столбцу, так что теперь мы имеем -

Текущий рабочий лист

Пользователи просто выбирают пользователя, нажимают кнопку, чтобы загрузить / копировать их данные и бум, у них есть различия, после которых они были.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .