excel - 将前两个实例保留在一列重复项中

Question

我有一长串项目，其中一些是一列中的重复标识号。整个电子表格中的记录并不重复。当按不同的值（时间/日期）排序时，我希望从重复数字的前两次迭代中提取前两行。

我已经看到有关保留重复项的第一个实例，但没有将前两个实例保留在记录中的主题。我正在寻找公式或 vba。谢谢

Answer 1

首先对您的记录进行排序，以便您要保留的记录在列的较高位置。

添加一列，您将在其中放置公式（我假设第一个 ID 号在单元格 A1 中）：

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

将公式拖到表格底部并复制/粘贴值以删除公式。

插入过滤器，您可以仅过滤 1 和 2 的结果，以获得 ID 号的前两个实例。复制到新的电子表格以仅获取工作表中的内容。

Answer 2

这是一个应该执行您所要求的子程序，您需要将其更改为您的特定数据，因为它假定 A 到 G 列包含您要提取的数据，并且 A 列具有重复数据，B 列包含您要排序的其他数据，并且 A 列的数据中没有空单元格。

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