Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 01.02.2012, 16:49   #1
Wind-up Bird
Пользователь
 
Регистрация: 12.11.2011
Сообщений: 27
По умолчанию Удаление дубликатов

Помогите написать макрос. Задача следующая: иметься таблица не постоянного размера, полученная из программы. В этой таблице есть повторяющиеся строчки с одинаковой информацией. Необходимо в исходной таблице удалить повторяющиеся подряд строки. и в ближайшем свободном столбце напротив каждой оставшейся строки вставить количество подряд повторяющихся строк с одинаковой информацией.

В прикрепленном файле пример. На "Лист1" - исходная таблица. На "Лист2" - желаемый результат.
Заранее спасибо за помощь
Вложения
Тип файла: zip Книга1.zip (7.3 Кб, 16 просмотров)
Wind-up Bird вне форума Ответить с цитированием
Старый 01.02.2012, 17:06   #2
Slavatron1984
Форумчанин
 
Аватар для Slavatron1984
 
Регистрация: 04.12.2011
Сообщений: 148
По умолчанию

Для справки, если поможет в екселе 2010 есть функция "Удалить дубликаты", которая находится в вкладки "данные", потом есть макрос который находит и окрашивает одним цветом дубликаты!!!

Sub Main()
Dim x As Range, y As New Collection, i As Long, j As Integer, k As Integer, a()
With Application
.FindFormat.Clear: .ReplaceFormat.Clear: .ScreenUpdating = False
With ActiveSheet.UsedRange
.Replace "0", "", xlWhole: .Replace "00", "", xlWhole
For i = .Rows.Count To 2 Step -1
If Rows(i).Text = "" Then Else Exit For
Next
End With
Set x = Range([A2], Cells(i - 1, 20)): a = x.Value: k = 2
x.NumberFormat = "@": x.Interior.ColorIndex = xlNone
For i = 1 To UBound(a, 1)
For j = 1 To UBound(a, 2)
If a(i, j) <> "" Then
On Error Resume Next
y.Add a(i, j), CStr(a(i, j))
If Err <> 0 Then
k = IIf(k > 18, 3, k + 1): .ReplaceFormat.Interior.ColorIndex = k
.[A:T].Replace a(i, j), a(i, j), xlWhole, , , , , True: On Error GoTo 0
End If: End If: Next: Next: End With
End Sub
Slavatron1984 вне форума Ответить с цитированием
Старый 01.02.2012, 17:07   #3
Slavatron1984
Форумчанин
 
Аватар для Slavatron1984
 
Регистрация: 04.12.2011
Сообщений: 148
По умолчанию

Я в не силен в екселе, но стараюсь. Могу помочь только собранной на эту тему архив...
Slavatron1984 вне форума Ответить с цитированием
Старый 01.02.2012, 17:27   #4
Wind-up Bird
Пользователь
 
Регистрация: 12.11.2011
Сообщений: 27
По умолчанию

Цитата:
Сообщение от Slavatron1984 Посмотреть сообщение
Для справки, если поможет в екселе 2010 есть функция "Удалить дубликаты", которая находится в вкладки "данные", потом есть макрос который находит и окрашивает одним цветом дубликаты!!!

Sub Main()
Dim x As Range, y As New Collection, i As Long, j As Integer, k As Integer, a()
With Application
.FindFormat.Clear: .ReplaceFormat.Clear: .ScreenUpdating = False
With ActiveSheet.UsedRange
.Replace "0", "", xlWhole: .Replace "00", "", xlWhole
For i = .Rows.Count To 2 Step -1
If Rows(i).Text = "" Then Else Exit For
Next
End With
Set x = Range([A2], Cells(i - 1, 20)): a = x.Value: k = 2
x.NumberFormat = "@": x.Interior.ColorIndex = xlNone
For i = 1 To UBound(a, 1)
For j = 1 To UBound(a, 2)
If a(i, j) <> "" Then
On Error Resume Next
y.Add a(i, j), CStr(a(i, j))
If Err <> 0 Then
k = IIf(k > 18, 3, k + 1): .ReplaceFormat.Interior.ColorIndex = k
.[A:T].Replace a(i, j), a(i, j), xlWhole, , , , , True: On Error GoTo 0
End If: End If: Next: Next: End With
End Sub


Это не подходит. Эти оба варианта ищут дубликаты во всем диапазоне. А мне нужно только рядом расположенные. Т.е подобие групировки с указанием количества сгрупированных ячеек.

Последний раз редактировалось Wind-up Bird; 01.02.2012 в 17:32.
Wind-up Bird вне форума Ответить с цитированием
Старый 01.02.2012, 17:50   #5
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Чтоб не писать спецкод под задачу, можно использовать готовый из файла в теме
http://www.planetaexcel.ru/forum.php?thread_id=26105
Но сперва нужно подготовить данные - слить вместе через разделитель | в одной ячейке каждую строку, а правее каждой такой строке поставить единицы.
Далее обработать эти два столбца макросом - получим такие данные (часть):

02.00|STORAGE|A-K05022-TEXT-|||220|390| 1
02.00.1|STORAGE RACK (4 TIERS)|A-MTR-Q2172G2Q74P-G|METROMAX_Q|Metro|1825|530|1900 15
02.00.1|STORAGE RACK (4 TIERS)|A-MTR-Q2160G2Q74P-G|METROMAX_Q|Metro|1524|530|1900 1
02.00.2|STORAGE RACK (4 TIERS)|A-MTR-Q2148G2Q74P-G|METROMAX_Q|Metro|1219|530|1900 1
02.00.3|STORAGE RACK (4 TIERS)|A-MTR-Q2142G2Q74P-G|METROMAX_Q|Metro|1066|530|1900 3
02.01.1|STORAGE RACK (4 TIERS)|A-MTR-Q2160G2Q74P-G|METROMAX_Q|Metro|1524|530|1900 1
02.01.2|STORAGE RACK (4 TIERS)|A-MTR-Q2148G2Q74P-G|METROMAX_Q|Metro|1219|530|1900 4

Теперь можно разбить слитое назад по столбцам.

Ну а если задача не разовая - можно на основе того кода написать код, чтоб не надо было сливать/делить и тянуть единицы.
webmoney: E265281470651 Z422237915069 R418926282008

Последний раз редактировалось Hugo121; 01.02.2012 в 17:57.
Hugo121 вне форума Ответить с цитированием
Старый 01.02.2012, 18:50   #6
Djeki
Форумчанин
 
Регистрация: 24.01.2011
Сообщений: 136
По умолчанию

Вот тема на эту тему, извините за каламбур.
http://www.programmersforum.ru/showt...157#post814157
Уважаемый Hugo121 , там очень доходчиво объяснил как наиболее быстро решать подобные задачи с помощью Словаря.
А метод Slavatron1984 на больших объемах будет работать долго..или очень долго..
Djeki вне форума Ответить с цитированием
Старый 01.02.2012, 18:55   #7
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Предложенный выше готовый код в файле тоже на словаре - а как иначе...
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Старый 01.02.2012, 19:24   #8
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Данную задачу на словаре можно сделать так: в словаре запоминается строка, состоящая из данных всей строки таблицы, и к каждой строке запоминаем счётчик.
Если такая строка встречается повторно - увеличиваем ей счётчик. Если ещё такой не было - заносим в словарь с счётчиком 1.

Ну а код в файле по ссылке сделан иначе - в словаре запоминаем строку и позицию в созданном массиве, где хранится тот же счётчик (на самом деле там собирается сумма, поэтому нужно сперва всем поставить единицы), ну и ещё сопутствующие данные. Это что-то вроде подхода при сравнении диапазонов/массивов.

Принцип работы со словарём при сравнении диапазонов такой - сперва просматриваем одну группу данных и запоминаем, что смотрели и где находится. Запоминаем в словаре.
Затем просматриваем вторую группу и сразу, без дополнительных циклов и поисков, получаем сведения - было такое или нет, и где лежат соотв. данные. Сведения из словаря.
Далее по этим сведениям можем действовать как угодно - извлечь эти (или те) данные в другой массив или стереть в исходном.
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Старый 02.02.2012, 09:40   #9
Wind-up Bird
Пользователь
 
Регистрация: 12.11.2011
Сообщений: 27
По умолчанию

Цитата:
Сообщение от Hugo121 Посмотреть сообщение
Данную задачу на словаре можно сделать так: в словаре запоминается строка, состоящая из данных всей строки таблицы, и к каждой строке запоминаем счётчик.
Если такая строка встречается повторно - увеличиваем ей счётчик. Если ещё такой не было - заносим в словарь с счётчиком 1.
А можно привести код, как это можно реализовать
Wind-up Bird вне форума Ответить с цитированием
Старый 02.02.2012, 12:49   #10
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Не поверите - лениво писать опять и снова этот код...
Вот нашёл нечто готовое:

Код:
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 0 To UBound(arr)
s = arr(i)
.Item(s) = .Item(s) + 1
Next
ReDim b(1 To .Count, 1 To 2)
For Each dd In .Keys
ii = ii + 1
b(ii, 1) = dd
b(ii, 2) = .Item(dd)
Next
[a1].Resize(.Count, 2) = b
End With
Тут массив arr уже содержит такие слитые строки.

Но для Вашей задачи думаю нужно сделать примерно так - перебором исходных данных (массива из них) формируем переменную temp в виде такой слитой строки, которую заносим в словарь.
Если заносим - тут же копируем исходные данные в заранее созданный пустой массив нужного размера (в высоту с общие исходные данные, шириной + 1 столбец дла подсчёта повторов), в Item кладём номер строки в этом массиве, ну и в этот же массив начинаем собирать количество повторов (заносим 1).
Если уже было - извлекаем из Item словаря номер строки массива, в этой строке прибавляем к счётчику повторов единичку.
В конце выгружаем на лист заполненную верхушку этого массива.

Но если Вам непременно нужно "физически" удалять ненужные строки в исходной таблице - тогда всё сложнее, нужно где-то собирать номера таких строк и номера нужных строк, потом циклом снизу удалять ненужные, а в нужные ставить количество повторов... И смотри не перепутай!
И всё будет ужасно медленно...
Тягомотина, рутина...
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Удаление дубликатов с ListBox celovec Общие вопросы Delphi 7 13.09.2016 09:07
Удаление дубликатов строк hon Паскаль, Turbo Pascal, PascalABC.NET 10 02.08.2011 05:29
удаление дубликатов в ListView fate Общие вопросы Delphi 8 12.05.2011 16:51
Удаление дубликатов Deltist Microsoft Office Excel 11 14.01.2011 16:01
удаление дубликатов и группировка строк Serglen Microsoft Office Excel 2 30.07.2008 15:51