Как отфильтровать данные в одном столбце, а затем получить значение в другом столбце, которое связано с отфильтрованными данными

Question

У меня база данных + - 15000 строк.В столбце U есть коды моделей, которые мне нужно отфильтровать.В столбце HI есть список уникальных номеров активов.Несколько моделей, каждая с уникальным номером актива.Поэтому мне нужен один из уникальных номеров активов в столбце H для каждого отфильтрованного кода модели, который затем копируется и вставляется в столбец A Sheet2. Я могу фильтровать с помощью приведенного ниже кода, но как мне получить одно уникальное значение в столбце H?

Sub SumGroups()
    Dim lastCode As Long, lastFiltCode As Long

    'Determine Last Row in Column U (Unfiltered Codes)
     With Worksheets("Database") lastCode = .Range("U" & .Rows.Count).(xlUp).Row

    'Filter Unique Codes into Column A Sheet2
    .Range("U2:U" & lastCode).AdvancedFilter Action:=xlFilterCopy, _
            CopyToRange:=Worksheets("Sheet2").Range("A1"), Unique:=True
    End With
End Sub

Answer 1

Хотя я бы сказал, что самый простой способ сделать это - использовать Pivot Table , ниже приведено решение для вашего кода, если вам нужно решение с использованием VBA.

Вы можете использоватьФункция RemoveDuplicates после копирования данных в Sheet2 позволяет сохранять только уникальные значения, как показано ниже.

Я еще не проверял, работает ли это еще, но из того, что я вижу, должно быть.

Dim lastCode As Long, lastFiltCode As Long

'Determine Last Row in Column U (Unfiltered Codes)
 With Worksheets("Database") lastCode = .Range("U" & .Rows.Count).(xlUp).Row

'Filter Unique Codes into Column A Sheet2
.Range("U2:U" & lastCode).AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=Worksheets("Sheet2").Range("A1"), Unique:=True
End With
'Use Header:=xlNo below is Sheet2 doesn't have header
Worksheets("Sheet2").Range("A1:A100").RemoveDuplicates Columns:=Array(1), Header:=xlYes
End Sub

Измените Range ("A1: A100") выше на соответствующий диапазон в Sheet2.