2016-06-09 3 views
1

Я хочу удалить все из повторяющихся строк в каждом столбце, включая первую дублируемую строку, оставляя только строки, у которых не было никаких дубликатов, , но повторяющиеся строки должны совпадать в обоих столбцах. Возможно ли это как-то в таблице с тысячами строк?Удалите повторяющиеся строки, включая первую строку, связанную с несколькими столбцами

A   B 
ID201  225 (leave this) 
ID201  233 (leave this) 
ID202  555 (delete this) 
ID202  555 (delete this) 
etc 
+1

Выбор столбца A и B, выберите Data> Удалить Дубликаты – MutjayLee

+0

Но эта функция будет оставить первый один ряд, не правда ли ?. – Edoras

+0

Эта функция будет удалять только одно данные каждого типа и удалять все. Делает все данные уникальными. – MutjayLee

ответ

1

Использование макроса происходит медленным способом и быстрым способом для этого. Если вы знаете, что каждый элемент в первом столбце будет иметь форму «ID somenumber», мы можем использовать быстрый метод. Если нет, то должен использоваться медленный метод (проверяющий каждую строку в каждой строке). Я включил код для быстрого метода ниже

Sub RemoveDuplicates() 

Dim IDVals As Object, RowsToDelete As String, ItemsToDelete As String 
Set IDVals = CreateObject("Scripting.Dictionary") 

Dim CheckCell As Range 
For Each CheckCell In ActiveSheet.Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1)) 
    If Not IDVals.Exists(CheckCell.Value) And Not IsEmpty(CheckCell) Then 
     IDVals.Add (CheckCell.Value), CheckCell.Address 
    Else 
     If ActiveSheet.Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1)).Offset(0, 1).Value = CheckCell.Value Then 
      RowsToDelete = RowsToDelete & CheckCell.Row & "," 
      ItemsToDelete = ItemsToDelete & CheckCell.Value & "," 
     End If 
    End If 
Next CheckCell 

RowsToDelete = Left(RowsToDelete, Len(RowsToDelete) - 1) 'Removing last comma 
Dim ParsedText() As String, Count As Integer, DeleteRange As Range 
Elements = Len(RowsToDelete) - Len(Replace(RowsToDelete, ",", "")) 'Array of the length of elements 
ReDim ParsedText(Elements) 
ParsedText = Split(TextBox1.Value, ",") 
DeleteRange = Range(Cells(Val(ParsedText(0)), 1).Address).EntireRow 

For Count = 1 To Elements 

    DeleteRange = Union(DeleteRange, Range(Cells(Val(ParsedText(Count)), 1).Address).EntireRow) 

Next Count 

DeleteRange.Delete 

Dim IdValkey As String 

'eliminating first instance of repeated value 
For Each IdValkey In Split(Left(ItemsToDelete, Len(ItemsToDelete) - 1), ",") 
    For Count = ActiveSheet.Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1)) To 1 
     If Cells(Count, 1).Value = IdValkey Then 
      Range(Cells(Count, 1).Address).EntireRow.Delete 
     End If 
    Next Count 
Next IdValkey 
End Sub 
+0

Просто понял, что вам нужны оба столбца. скоро скорректирует код для этого момента. – RGA

+0

Код теперь исправляется для работы по желанию. Трюк (который делает код намного быстрее) использует объект словаря, хотя это зависит от того, что формат строки элементов в первом столбце идентичен (те, которые должны быть одинаковыми, но не идентичными, будут прошел без более умного анализа строк, который я не удосужился включить) – RGA

+0

@edoras сделал это для вас? – RGA

Смежные вопросы