Страницы: 1
RSS
Найти неповторяющиеся нормы у повторяющихся заказов
 
Здравствуйте,
может Вы мне поможите:  Речь идет о 5 000 строк и двух столбцах значение которых, нужно сравнить и найти ошибку. В столбцах много дубликатов- их и нужно проверить на наличее неравенства. Если такое вообще возможно!
У меня каждую неделю новая таблица 5 - 6 000 строк на проверку.
Подскажите, пожалуйста.
Заранее огромное спасибо
Изменено: Юрий М - 10.04.2022 11:45:10
 
Выглядит примерно так..
 
Цитата
Albina Kožokarová написал:
работа с повторяющимися значениями
Что за работа?  Переформулируйте и предложите новое название, из которого будет понятна задача - модераторы поменяют.
И зачем файл отдельным сообщением? Ведь можно было прикрепить к первому.
 
Я незнаю как изменить название.
Задание ведь тоже неоднозначное. В целом интернете нет ничего похожего.  
Изменено: Albina Kožokarová - 08.04.2022 21:03:53
 
Код
двух столбцах значение которых, нужно сравнить и найти ошибку

Что вы подразумеваете под ошибкой? Поясните на примере задачи 1
 
Здравствуйте,
сначала благадарю за попытку помочь мне разобраться :)

в одном столбце числа заказов (большенство повторяються)
в другом столбце норма (тоже повторяеться)
у каждого заказа своя норма, но может случиться, что у одного и того же заказа норма сначала одна а через тысячи рядов другая.
такой заказ нужно найти, и сравнить нормы.
Я Вам покажу оригинал таблицу.  
 
Цитата
Albina Kožokarová написал:
Я незнаю как изменить название.

Перечитайте это:
Цитата
Юрий М написал:
предложите новое название, из которого будет понятна задача - модераторы поменяют.
 
Код
Sub iZadacha()
Dim i As Long
Dim iLastRow As Long
Dim iFoundZadacha As Range
Dim FAdr As String
 iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
   Range("K1:L" & iLastRow).Clear
   Range("A2:A" & iLastRow).AdvancedFilter xlFilterCopy, CopyToRange:=Range("K1"), Unique:=True
   For i = 2 To Cells(Rows.Count, "K").End(xlUp).Row
     If Application.WorksheetFunction.CountIf(Range("A2:A" & iLastRow), Cells(i, "K")) > 1 Then
        Set iFoundZadacha = Columns(1).Find(Cells(i, "K"), , xlFormulas, xlWhole)
          FAdr = iFoundZadacha.Address
        Do
          Cells(i, "L") = Cells(i, "L") & iFoundZadacha.Row & ", "
          Set iFoundZadacha = Columns(1).FindNext(iFoundZadacha)
        Loop While iFoundZadacha.Address <> FAdr
     End If
   Next
End Sub

Макрос выводит в столбец К уникальные задачи, а в столбец L строки, где эти задачи совпадают.
Какие нормы правильные вам решать.
 
я даже незнаю как Вас отблагодарить!
Вы мой кумир!!!
Огромное спасибо!
 
Kuzmich:
Простите меня пожалуйста,
Мне очень неловко опять к Вам обращаться, но меня безнадёжность заставляет.
Ваши макра работают, дубликаты находят.
Хотела Вас еще попросить их управить так, чтоб одинаковые нормы не отображались.
Если это возможно.
Пожалуйста помогите.
 
Albina Kožokarová, попробуйте запустить этот макрос (см. файл)
 
Ох как кот будет зол!!!!
По вопросам из тем форума, личку не читаю.
 
Могу предложить название темы: Найти неповторяющиеся нормы у повторяющихся заказов
Изменено: New - 10.04.2022 09:57:23
 
Цитата
чтоб одинаковые нормы не отображались
Код
Sub iZadacha()
Dim i As Long
Dim iLastRow As Long
Dim iFoundZadacha As Range
Dim FAdr As String
Dim Norma As Range
 iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
   Range("K1:L" & iLastRow).Clear
   Range("A2:A" & iLastRow).AdvancedFilter xlFilterCopy, CopyToRange:=Range("K1"), Unique:=True
   For i = 2 To Cells(Rows.Count, "K").End(xlUp).Row
     If Application.WorksheetFunction.CountIf(Range("A2:A" & iLastRow), Cells(i, "K")) > 1 Then
        Set iFoundZadacha = Columns(1).Find(Cells(i, "K"), , xlFormulas, xlWhole)
          FAdr = iFoundZadacha.Address
          Set Norma = iFoundZadacha.Offset(, 1)
          Cells(i, "L") = iFoundZadacha.Row & ", "
        Do
          If iFoundZadacha.Offset(, 1) <> Norma Then
            Cells(i, "L") = Cells(i, "L") & iFoundZadacha.Row & ", "
          End If
          Set iFoundZadacha = Columns(1).FindNext(iFoundZadacha)
        Loop While iFoundZadacha.Address <> FAdr
     End If
   Next
End Sub
 
Большое спасибо!
Все работает!
Изменено: Albina Kožokarová - 10.04.2022 16:17:22
Страницы: 1
Наверх