将前两个实例保存在excel中的重复列中

时间:2013-08-15 20:23:16

标签: excel duplicates

我有很长的项目列表,其中一些是一列中的重复标识号。整个电子表格中的记录不是重复的。我想从不同的值(时间/日期)排序时,从重复数字的前两次迭代中提取前两行。

我见过关于保留重复项的第一个实例的主题,但没有将前两个实例保留在记录中。我正在寻找一个公式或vba。 感谢

2 个答案:

答案 0 :(得分:0)

首先对您的记录进行排序,以便您想要保留的记录在列中更高。

添加一个列,您将放置公式(我假设第一个ID号位于单元格A1中):

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

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

插入过滤器,您只能过滤1和2的结果,以获取ID号的前两个实例。复制到新的电子表格,只获取表格中的那些。

答案 1 :(得分:0)

这是一个应该按照您的要求执行操作的子程序,您需要将其更改为您的特定数据,因为它假定列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