Как именно выбрать все дупликаты, а не выделить другим цветом. [moder]Мне очень любопытно, вы из этого вопроса снова по-английски уйдете не отписавшись?
Как именно выбрать все дупликаты, а не выделить другим цветом. [moder]Мне очень любопытно, вы из этого вопроса снова по-английски уйдете не отписавшись?kioki
Сообщение отредактировал _Boroda_ - Вторник, 28.07.2015, 23:49
что вы имеете в виду?удалить дубликаты,вытащить их в отдельный столбик или просто отметить.или что?поконкретней можно.и с примером вашим. а так можно вкладка данные-удалить дубликаты
что вы имеете в виду?удалить дубликаты,вытащить их в отдельный столбик или просто отметить.или что?поконкретней можно.и с примером вашим. а так можно вкладка данные-удалить дубликатыкитин
Не судите очень строго:я пытаюсь научиться ЯД 41001877306852
Сообщение отредактировал китин - Среда, 29.07.2015, 11:33
With CreateObject("scripting.dictionary"): .comparemode = 1 a = [a1].CurrentRegion.Columns(1).Resize(, 3).Value For x = 1 To 3 For i = 1 To UBound(a) If .Item(a(i, x)) = x - 1 Then .Item(a(i, x)) = x Next Next For Each k In .keys If .Item(k) <> 3 Then .Remove k Next
Workbooks.Add.Worksheets(1).Range("A1").Resize(.Count, 1) = Application.Transpose(.keys) End With
End Sub
[/vba]
Макрос: [vba]
Код
Sub tt() Dim a(), x&, i&, k
With CreateObject("scripting.dictionary"): .comparemode = 1 a = [a1].CurrentRegion.Columns(1).Resize(, 3).Value For x = 1 To 3 For i = 1 To UBound(a) If .Item(a(i, x)) = x - 1 Then .Item(a(i, x)) = x Next Next For Each k In .keys If .Item(k) <> 3 Then .Remove k Next
Workbooks.Add.Worksheets(1).Range("A1").Resize(.Count, 1) = Application.Transpose(.keys) End With
Hugo, спасибо, но я чуть-чуть напутал. Надо не дупликаты, которые встречаются в каждом из столбцов, а те из двух первых столбцов, которые есть в третьем. Извините
Hugo, спасибо, но я чуть-чуть напутал. Надо не дупликаты, которые встречаются в каждом из столбцов, а те из двух первых столбцов, которые есть в третьем. Извините kioki
Тогда где-то так. Логику не менял. Если в третьем столбце будут пустые ячейки - могут проскочить в результат, или не все данные будут проверены. [vba]
Код
Sub tt() Dim a(), x&, i&, k
With CreateObject("scripting.dictionary"): .comparemode = 1 a = [a1].CurrentRegion.Columns(1).Resize(, 3).Value
For i = 1 To UBound(a) .Item(a(i, 3)) = 3 Next For x = 1 To 2 For i = 1 To UBound(a) If .Item(a(i, x)) = 3 Then .Item(a(i, x)) = 1 Next Next For Each k In .keys If .Item(k) <> 1 Then .Remove k Next
Workbooks.Add.Worksheets(1).Range("A1").Resize(.Count, 1) = Application.Transpose(.keys) End With
End Sub
[/vba]
Тогда где-то так. Логику не менял. Если в третьем столбце будут пустые ячейки - могут проскочить в результат, или не все данные будут проверены. [vba]
Код
Sub tt() Dim a(), x&, i&, k
With CreateObject("scripting.dictionary"): .comparemode = 1 a = [a1].CurrentRegion.Columns(1).Resize(, 3).Value
For i = 1 To UBound(a) .Item(a(i, 3)) = 3 Next For x = 1 To 2 For i = 1 To UBound(a) If .Item(a(i, x)) = 3 Then .Item(a(i, x)) = 1 Next Next For Each k In .keys If .Item(k) <> 1 Then .Remove k Next
Workbooks.Add.Worksheets(1).Range("A1").Resize(.Count, 1) = Application.Transpose(.keys) End With