Сохранение первых двух экземпляров в столбце дубликатов в excel

Question

У меня есть длинный список элементов, в которых некоторые являются повторяющимися идентификационными номерами в одном столбце. Записи не дублируются по всей электронной таблице. Я хочу извлечь первые две строки из первых двух итераций дублированных чисел при сортировке по другому значению (время/дата).

Я видел темы по хранению первого экземпляра повторяющихся элементов, но не сохранял первые два экземпляра в записях. Я ищу формулу или vba. Thanks

Answer 1

Сначала сортируйте свои записи так, чтобы те, которые вы хотите сохранить, выше столбца.

Добавить колонку, в которой вы будете ставить формулу (я предполагаю, что первый идентификационный номер находится в ячейке A1):

=COUNTIF($A$1:A1, A1) 

Перетащите формулу в нижней части таблицы и копирования значений/вставки чтобы удалить формулу.

Вставьте фильтр, и вы можете фильтровать только результаты 1 и 2, чтобы получить первые два экземпляра идентификационных номеров. Скопируйте в новую таблицу, чтобы получить только те, что указаны в листе.

Answer 2

Вот подпрограмма, которая должна делать то, что вы просите, вам нужно будет изменить ее на ваши конкретные данные, поскольку предполагается, что столбцы от A до G содержат данные, которые вы хотите извлечь, и что в столбце A есть дубликаты данных, столбец B содержит другие данные, которые вы хотите отсортировать, и что в данных для столбца отсутствуют пустые ячейки.

Sub SortAndExctract() 

Dim wsInputWorksheet As Worksheet 
Dim wsOutputWorksheet As Worksheet 
Dim lInputRowNumber As Long 
Dim lOutputRowNumber As Long 
Dim sLastExtract As Variant 'A variant as I don't know what type of value you are looking for 
Dim iColumnCounter As Integer 



'Sort the worksheet, assumes that the columns are in the range A:G and that you 
'Want to sort according to column A and then column B 
Range("A:G").Select 
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, _ 
    Key2:=Range("B1"), Order2:=xlAscending, Header:=xlGuess, _ 
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal 

Set wsInputWorksheet = ThisWorkbook.ActiveSheet 
Set wsOutputWorksheet = ThisWorkbook.Worksheets.Add 
lInputRowNumber = 1 
lOutputRowNumber = 1 

'Until an empty cell is found check for duplicate values in column A 
'Assumes that you don't have empty cells in column A within your data 
'and that the duplicate values are in column A 

Do While wsInputWorksheet.Cells(lInputRowNumber, 1).Value <> Empty 
    If wsInputWorksheet.Cells(lInputRowNumber, 1).Value <> sLastExtract Then 
     If wsInputWorksheet.Cells(lInputRowNumber, 1).Value = wsInputWorksheet.Cells(lInputRowNumber + 1, 1).Value Then 
       For iColumnCounter = 1 To 6 'Assuming againg that colum G is the last column 
        'copy cells to output worksheet 
        wsOutputWorksheet.Cells(lOutputRowNumber, iColumnCounter).Value = _ 
         wsInputWorksheet.Cells(lInputRowNumber, iColumnCounter).Value 
        wsOutputWorksheet.Cells(lOutputRowNumber + 1, iColumnCounter).Value = _ 
         wsInputWorksheet.Cells(lInputRowNumber + 1, iColumnCounter).Value 
       Next iColumnCounter 
       lInputRowNumber = lInputRowNumber + 1 'Will be incremented again later 
       lOutputRowNumber = lOutputRowNumber + 2 
     End If 
    End If 
    lInputRowNumber = lInputRowNumber + 1 
Loop 
End Sub