Developing.ru

У меня проблемка есть…может поможете!

Мне надо, чтоб макрос удалял одинаковые строчки в Экселе. Т.е. стирал дублирующую информацию.
А если отличается на одну ячейку, то метил всё строчку цветом.
Но самое главное, чтоб удалял одинаковые.

Как это можно сделать?

Код: Выделить всё

Sub qwe()
Dim sh As Range, r As Range
  Set sh = ActiveCell.CurrentRegion
  ColCnt = sh.Columns.Count
  For i = sh.Rows.Count - 1 To 1 Step -1
    diff_cnt = 0
    For j = 1 To ColCnt
      If sh.Cells(i + 1, j).Value <> sh.Cells(i, j).Value Then diff_cnt = diff_cnt + 1
      If diff_cnt > 1 Then Exit For
    Next
    Select Case diff_cnt
      Case 0: sh.Rows(i).Delete xlUp
      Case 1: sh.Rows(i + 1).Interior.ColorIndex = 8
    End Select
  Next
End Sub

Макрорс опирается на ActiveCell.CurrentRegion, т.е. на ближайшую таблицу с данными вокруг текущей ячейки. Если надо иное, то эту строчку исправить.

Просто и красиво.!
И хоть не я этот вопрос задавал, но уж очень мне ответ(код) понравился. Я это решал по другому. Теперь буду пользоваться вашим.!

Однако , постойте...!
:!:
webfile.ru/139945

terminator писал(а):Просто и красиво.!
И хоть не я этот вопрос задавал, но уж очень мне ответ(код) понравился. Я это решал по другому. Теперь буду пользоваться вашим.!

а как?

Naeel Maqsudov писал(а): Макрорс опирается на ActiveCell.CurrentRegion, т.е. на ближайшую таблицу с данными вокруг текущей ячейки. Если надо иное, то эту строчку исправить.

что-то вообще ничего ваш макрос не делает

Нет почему-же, он действительно удаляет повторы.
Вы не торопитесь с критикой. Однако когда я решил применить его у себя в рабочем файле, то это решение в том виде в каком оно представлено - непреемлемо. В файле webfile.ru/139945
я представил тот вариант в котором он не работает, естественно могу представить тот в котором он работает. Но это не подходит для реальной работы в офисе. Так как не я автор, то замечу только одно - требуется доработка.
Лично я до этого времени пользовался кодом "выбор без повторов", из справочника Джона Уокенбаха, (чтоб не заниматся плагиатом - стр. 375.) Однако советовать это вам не могу ибо он не позволяет удалять записи. Он помещает их или в MsgBox или ещё куда либо. Ещё проще - я использовал его же формулу массива "Возврашение списка уникальных значений диапазона" - стр. 358 "Подробное руководство по созданию формул в Excel 2002".
Конечно это тоже не то, что вы просите.Ибо данные опять таки помещяются в отдельный диапазон. Как выбрать уникальные записи, удалив при этом повторяюшиеся в том же столбце - лично я не знаю, и тоже этим интересуюсь.
Какие у кого варианты.?

В приведённом примере Naeel Maqsudov, сделал просто сравнение двух соседних строк, если же Вам нужно удалять все повторы из региона, то просто добавляется ещё один внешний цикл:

Код: Выделить всё

Sub qwe()
Dim sh As Range, r As Range, ColCnt As Integer, I As Integer, J As Integer, diff_cnt As Integer
Dim IM As Integer
  Set sh = ActiveCell.CurrentRegion
  ColCnt = sh.Columns.Count
  For IM = sh.Rows.Count - 1 To 2 Step -1
    For I = sh.Rows.Count - 2 To 1 Step -1
      diff_cnt = 0
      For J = 1 To ColCnt
        If sh.Cells(IM, J).Value <> sh.Cells(I, J).Value Then diff_cnt = diff_cnt + 1
        If diff_cnt > 1 Then Exit For
      Next
      Select Case diff_cnt
        Case 0: sh.Rows(I).Delete xlUp
        Case 1: sh.Rows(IM).Interior.ColorIndex = 8
      End Select
    Next
  Next
End Sub

если же Вам нужно удалять все повторы из региона, то просто добавляется ещё один внешний цикл:

Игорь Акопян, Вы не обижайтесь , но Ваш внешний цыкл бесполезен. К сожалению не всё так просто. Вы мне не верите, посмотрите сами - webfile.ru/140706
На втором листе (в файле webfile.ru/140706) мой вариант о котором я говорил ранее. Т.е. выбор производится, но в отдельном диапазоне , а не в том же столбце. Имя диапазона из которого производится выбор без повторов - "ОБКТ". Из другого места выбор не будет производиться. Посмотрите код, выбор приозводит формула массива, а не код(макрос).
Так может кто-то сумеет написать код который делает выбор удаляет повторы и помещяет новые данные в то же место.?

Developing.ru

Удаление одинаковых данных в Экселе

Удаление одинаковых данных в Экселе