Всем доброй ночи! И снова требуется помощь специалистов. Имеется постоянно пополняемая база данных по товарам, в которой вручную приходится удалять дубликаты. Дубликатов бывает много и тратится слишком много времени на их поиск и удаление через сортировку. Как понимаю, для автоматизации процесса нужен макрос, написать который я явно не в состоянии. Суть задачи в поиске и удалении всех строк в таблице, которые содержат дубликаты кодов (колонка А в примере). Соответственно в базе должен оставаться один уникальный код (первый по счету) и все остальные данные находящиеся в одной строке с этим кодом. Буквально вчера была создана похожая тема, но все таки там задача немного другая http://www.excelworld.ru/forum/10-32783-1 Думаю, что после редактирования одного из предложенных макросов из этой темы, можно решить и мою задачу. Но я сам это сделать не в состоянии.
Всем доброй ночи! И снова требуется помощь специалистов. Имеется постоянно пополняемая база данных по товарам, в которой вручную приходится удалять дубликаты. Дубликатов бывает много и тратится слишком много времени на их поиск и удаление через сортировку. Как понимаю, для автоматизации процесса нужен макрос, написать который я явно не в состоянии. Суть задачи в поиске и удалении всех строк в таблице, которые содержат дубликаты кодов (колонка А в примере). Соответственно в базе должен оставаться один уникальный код (первый по счету) и все остальные данные находящиеся в одной строке с этим кодом. Буквально вчера была создана похожая тема, но все таки там задача немного другая http://www.excelworld.ru/forum/10-32783-1 Думаю, что после редактирования одного из предложенных макросов из этой темы, можно решить и мою задачу. Но я сам это сделать не в состоянии.Serge1400
Sub Killer() Dim Sh As Worksheet, key As String, S As String Set C_is = CreateObject("scripting.dictionary") Set Sh = ActiveSheet LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row dx = Sh.Range("A1:A" & LastRow) For n = 2 To UBound(dx) key = dx(n, 1) If C_is.Exists(key) Then S = S & "," & n Else C_is.Item(key) = n End If Next Z = Split(S, ",") Application.ScreenUpdating = False For n = UBound(Z) To 1 Step -1 Sh.Rows(Val(Z(n))).Delete Next Application.ScreenUpdating = True End Sub
[/vba]
Проверте, вдруг подойдет. [vba]
Код
Sub Killer() Dim Sh As Worksheet, key As String, S As String Set C_is = CreateObject("scripting.dictionary") Set Sh = ActiveSheet LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row dx = Sh.Range("A1:A" & LastRow) For n = 2 To UBound(dx) key = dx(n, 1) If C_is.Exists(key) Then S = S & "," & n Else C_is.Item(key) = n End If Next Z = Split(S, ",") Application.ScreenUpdating = False For n = UBound(Z) To 1 Step -1 Sh.Rows(Val(Z(n))).Delete Next Application.ScreenUpdating = True End Sub
А у Вас в строках-дубликатах количества разные! После удаления в единственной оставшейся должна быть сумма всех или первое встретившееся значение?
А у Вас в строках-дубликатах количества разные! После удаления в единственной оставшейся должна быть сумма всех или первое встретившееся значение?Perfect2You
А у Вас в строках-дубликатах количества разные! После удаления в единственной оставшейся должна быть сумма всех или первое встретившееся значение?
В живых остается первый попавшийся по счету дубликат, со всеми прицепленными к нему данными. Все остальное удаляется. Суммировать ничего не нужно.Serge1400
интересно у вас под кодом 78904 находятся два разных изделия. это ошибка или где?
Да, это именно где, а не ошибка. Просто не совсем удачный пример сделал. В оригинале нужно будет убивать дубли в базе таможенных пошлин, которые жестко пришиты только к коду (ТН ВЭД) и ни от чего другого не зависят. То есть одинаковые коды имеют одинаковые значения пошлины. Мне просто нужно было показать, что нужна сортировка только по одному столбцу -код.
интересно у вас под кодом 78904 находятся два разных изделия. это ошибка или где?
Да, это именно где, а не ошибка. Просто не совсем удачный пример сделал. В оригинале нужно будет убивать дубли в базе таможенных пошлин, которые жестко пришиты только к коду (ТН ВЭД) и ни от чего другого не зависят. То есть одинаковые коды имеют одинаковые значения пошлины. Мне просто нужно было показать, что нужна сортировка только по одному столбцу -код.Serge1400
Щааа проверим на предмет вдругподхождения. По результатам отпишусь. P.S. Cпасибо!
Проверил, вроде все убивает как задумано. И главное, что мне понятно как, при необходимости, в этом макросе колонку где надо шуровать переназначитьSerge1400
Сообщение отредактировал Serge1400 - Пятница, 17.03.2017, 22:32
Ну, если тот вдруг не подойдет, этот подойдет точно. [vba]
Код
Sub unA() Dim strBeg As Long, strMax As Long, strOk As Long, cOl1 As Long, cOl2 As Long, cOl3 As Long, cOl4 As Long Dim rN As Range, letT1 As String, letT2 As String, aRr As Variant strBeg = 3 cOl1 = 1 letT1 = Mid(Columns(cOl1).Address, 2, InStr(1, Columns(cOl1).Address, ":") - 2) strMax = Cells(Rows.Count, cOl1).End(xlUp).Row If strMax < (strBeg + 1) Then Exit Sub For strOk = strBeg + 1 To strMax If Evaluate("=SUMPRODUCT(--(" & letT1 & strOk & "=" & letT1 & strBeg & ":" & letT1 & (strOk - 1) & "))") Then If rN Is Nothing Then Set rN = Cells(strOk, cOl1) Else Set rN = Union(rN, Cells(strOk, cOl1)) End If End If Next strOk If Not (rN Is Nothing) Then rN.EntireRow.Delete Shift:=xlUp End Sub
[/vba] К кнопке подвязал.
Ну, если тот вдруг не подойдет, этот подойдет точно. [vba]
Код
Sub unA() Dim strBeg As Long, strMax As Long, strOk As Long, cOl1 As Long, cOl2 As Long, cOl3 As Long, cOl4 As Long Dim rN As Range, letT1 As String, letT2 As String, aRr As Variant strBeg = 3 cOl1 = 1 letT1 = Mid(Columns(cOl1).Address, 2, InStr(1, Columns(cOl1).Address, ":") - 2) strMax = Cells(Rows.Count, cOl1).End(xlUp).Row If strMax < (strBeg + 1) Then Exit Sub For strOk = strBeg + 1 To strMax If Evaluate("=SUMPRODUCT(--(" & letT1 & strOk & "=" & letT1 & strBeg & ":" & letT1 & (strOk - 1) & "))") Then If rN Is Nothing Then Set rN = Cells(strOk, cOl1) Else Set rN = Union(rN, Cells(strOk, cOl1)) End If End If Next strOk If Not (rN Is Nothing) Then rN.EntireRow.Delete Shift:=xlUp End Sub
Ну, если тот вдруг не подойдет, этот подойдет точно.
Ага, это тот который из недавней похожей темы, но модернизированный. Спасибо! Ща и его тож потискаем в рабочей среде. Кстати, а как в этом макросе переназначить "убойную" колонку скажем с А на В или С? Потискал на объемном файле - действительно шустрый!
Ну, если тот вдруг не подойдет, этот подойдет точно.
Ага, это тот который из недавней похожей темы, но модернизированный. Спасибо! Ща и его тож потискаем в рабочей среде. Кстати, а как в этом макросе переназначить "убойную" колонку скажем с А на В или С? Потискал на объемном файле - действительно шустрый!Serge1400
Сообщение отредактировал Serge1400 - Пятница, 17.03.2017, 22:53
Кстати, а как в этом макросе переназначить "убойную" колонку скажем с А на В или С?
Элементарно. [vba]
Код
cOl1 = 1
[/vba] Это задан первый столбец. Поменяете значение переменной или InputBox'ом запрашивайте - будет проверка и удаление дубликатов другого столбца.Perfect2You
Сообщение отредактировал Perfect2You - Суббота, 18.03.2017, 00:14