Страницы: 1
RSS
Проверка и формирование уникальных значений ячеек столбца таблицы
 
Добрый день.
Прошу совета или помощи в следующей ситуации.

Имеется сводный перечень "кодов элементов", полученных сборкой разных документов от разных исполнителей. В этом перечне необходимо проверить уникальность использованных "кодов", и, если попадаются неуникальные, сформировать новые значения, которые потом вернутся исполнителю для корректировки (как таблица соответствия старых и новых значений). Код формируется по определенным правилам и использовать "рандомные" функции или GUID-подобные вещи не представляется возможным.

1) Имеется код элемента. Если он до этого не встречался, то остается старое значение.
2) Если в ячейках выше код встречался, то текущему элементу необходимо присвоить окончание, допустим, "-01".
3) Если коды ниже повторяются неоднократно, то каждому последующему присваивать "-02", "-03" и т.д.

Можно ли выполнить требование по уникальности в пределах двух столбцов ("исходный код" - "новый код"), без макросов и вспомогательных столбцов для преобразований и фильтрации? В макросах не разбираюсь, а со вспомогательными столбцами не очень удобно.

Пример того, что должно получаться - во вложении. Для удобства "подсвечены" исходные дубликаты.
 
Цитата
Можно ли выполнить требование по уникальности в пределах двух столбцов ("исходный код" - "новый код"), без макросов
Я формулами не умею, вот попробуйте макрос
Код
Sub iKod()
Dim i As Long
Dim iLastRow As Long
Dim k As Long
Dim FoundArticul As Range
Dim FAdr As String
 iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
 Range("A1") = "Код"
 Range("B2:B" & iLastRow).ClearContents
 Range("H1:H" & iLastRow).ClearContents
    'уникальные из А в столбец H
 Range("A1:A" & iLastRow).AdvancedFilter xlFilterCopy, CopyToRange:=Range("H1"), Unique:=True
 iLastRow = Cells(Rows.Count, "H").End(xlUp).Row
      For i = 2 To iLastRow                        'цикл по уникальным
        Set FoundArticul = Columns(1).Find(Cells(i, "H"), , xlValues, xlWhole)
         If Not FoundArticul Is Nothing Then       'первое совпадение
            FAdr = FoundArticul.Address            'адрес первого совпадения
            Cells(FoundArticul.Row, "B") = Cells(FoundArticul.Row, "A")
            k = 1
          Do                                       'ищем следующее совпадение
           Set FoundArticul = Columns(1).FindNext(FoundArticul)
           If FoundArticul.Address <> FAdr Then    'есть еще совпадение
             Cells(FoundArticul.Row, "B") = Cells(FoundArticul.Row, "A") & "-0" & k
             k = k + 1
           End If
          Loop While FoundArticul.Address <> FAdr  'ищем совпадения пока не дойдем до FAdr
         End If
      Next
        Range("H1:H" & iLastRow).ClearContents
End Sub
 
Kuzmich, где-то в макросе ошибка - копируется только форматирование:
 
Результат в столбце В, попробуйте его очистить и запустить макрос
 
Kuzmich, круто, спасибо! А для чего делать копирование форматирования в столбец H?

Я цвет добавлял только для того, чтобы вам было удобнее понять, какие ячейки одинаковые. В реальным сводках его нет.
Будет неприятно, если в рабочем файле в столбце H (или любом другом) будут данные - они затрутся.
Можно обойтись манипуляциями только в двух столбцах?
 
Цитата
А для чего делать копирование форматирования в столбец H?
В столбце Н формируется список уникальных значений, цвет остается от
применения расширенного фильтра. Можно в конце кода просто удалить столбец Н.
 
Kuzmich,
Цитата
jeka-irbis написал: если в рабочем файле в столбце H (или любом другом) будут данные - они затрутся.
Пример - это просто сильно упрощенная таблица из двух столбцов. Сейчас рабочий файл имеет 15 столбцов, и столбец H заполнен.
В общем, идею я понял, как поправить макрос, чтобы это обойти.
Спасибо за помощь!!! Буду пока этим пользоваться)

P.S.: если все-таки у кого есть еще предложения по поводу
Цитата
jeka-irbis написал:
Можно ли выполнить требование по уникальности в пределах двух столбцов ("исходный код" - "новый код"), без макросов и вспомогательных столбцов для преобразований и фильтрации (формулами)?
буду крайне признателен.
 
Цитата
есть еще предложения по поводу
С дополнительным столбцом
В ячейку В2 формулу =СЧЁТЕСЛИ($A$2:A2;A2) и тянем вниз
В ячейку С2 формулу =ЕСЛИ(B2=1;A2;A2&"-0"&(B2-1)) и тянем вниз

Или можно так =ЕСЛИ(СЧЁТЕСЛИ($A$2:A2;A2)=1;A2;A2&"-0"&(СЧЁТЕСЛИ($A$2:A2;A2)-1))
Изменено: Kuzmich - 07.12.2019 20:23:16
 
Kuzmich,
Цитата
Kuzmich написал:
В ячейку В2 формулу =СЧЁТЕСЛИ($A$2:A2;A2) и тянем вниз
Я туплю - как формулу скопировать? При нажатии Enter выдается предупреждение, что это не формула и подсвечивается $A$2.
--------------------

Не переключился с R1C1 на A1. Все супер! Спасибо!!!
Изменено: jeka-irbis - 08.12.2019 21:35:44
Страницы: 1
Наверх