Удаление дубликатов в строке

[riabov5]

Добрый день!

Подскажите пожалуйста, как реализовать удаление дубликатов в строке. Как оставить только уникальные данные?

[IgorGO]

1. копируете А2:L4
2. вставляете специальной вставкой в N2 (транспонировать)
3. отмечаете N:P
4. Данные, Удалить дубликаты
5. копируете N1:P12
6. вставляете спецмальной вставкой в А2 (транспонировать)
7. удаляете колонки N:P

написать это все было дольше раза в 3, чем сделать.

[riabov5]

Сообщение от IgorGO

1. копируете А2:L4
2. вставляете специальной вставкой в N2 (транспонировать)
3. отмечаете N:P
4. Данные, Удалить дубликаты
5. копируете N1:P12
6. вставляете спецмальной вставкой в А2 (транспонировать)
7. удаляете колонки N:P

написать это все было дольше раза в 3, чем сделать.

Спасибо, дело в том, что имеется порядка 5 000 строк и после телефонов есть и другие данные, если так сделать, то будет сдвиг колонок.

[Hugo121]

Если не на МАКе:

Option Explicit

Sub tt()
    Dim r As Range, c As Range
    Application.ScreenUpdating = False
    With ActiveSheet.UsedRange
        For Each r In .Rows
            With CreateObject("scripting.dictionary"): .comparemode = 1
                For Each c In r.Cells
                    If Not .exists(c.Value) Then .Item(c.Value) = 0 Else c.Clear
                Next
            End With
        Next
    End With
    Application.ScreenUpdating = True
End Sub

[riabov5]

[QUOTE=Hugo121;1503501]Если не на МАКе:

Option Explicit

Sub tt()
    Dim r As Range, c As Range
    Application.ScreenUpdating = False
    With ActiveSheet.UsedRange
        For Each r In .Rows
            With CreateObject("scripting.dictionary"): .comparemode = 1
                For Each c In r.Cells
                    If Not .exists(c.Value) Then .Item(c.Value) = 0 Else c.Clear
                Next
            End With
        Next
    End With
    Application.ScreenUpdating = True
End Sub

[/QUOTE

Спасибо! То что нужно

[Hugo121]

Если много и так уже пустых ячеек - то есть смысл сперва проверить наличие значения, чтоб не удалять и так повтор пустых:

Sub tt()
    Dim r As Range, c As Range, t$
    Application.ScreenUpdating = False
    With ActiveSheet.UsedRange
        For Each r In .Rows
            With CreateObject("scripting.dictionary"): .comparemode = 1
                For Each c In r.Cells
                    t = c.Value
                    If Len(t) Then
                        If Not .exists(t) Then .Item(t) = 0& Else c.Clear
                    End If
                Next
            End With
        Next
    End With
    Application.ScreenUpdating = True
End Sub