Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Удаление дубликатов через VBA с учетом регистра
 
#1
04.05.2012 16:39:12
кнопка remove duplicate мне не очень подходит.    
у меня огромная таблица из 6 столбцов, нужно удалить строки-дубликаты остовываясь на совпадениях в 1 и 3 столбцах. При этом в первой есть одинаковые записи но в разном регистре. Для экселя они одинаковые, а для меня разные.  
Как быть? Видимо нужен макрос?
 
 
 
#2
04.05.2012 18:53:28
Скорее всего без макроса не обойтись. Ещё потребуется Ваш файл-пример (небольшой). Подобные вопросы обсуждались и давались решения - попробуйте поиском по форуму найти.
 
 
 
#3
04.05.2012 19:49:23
На словаре нужно делать. Или на System.Collections.ArrayList - но на словаре привычнее.  
Основное время займёт именно удаление строк.  
Обязательно нужно удалять? Проще и быстрее переложить нужное или на другой лист, или на этот же  очищенный от данных.  
 
Чуть кода - его можно использовать :)  
 
Sub tt()  
   Dim s$, ss$, oDict As Object, kk  
   Set oDict = CreateObject("Scripting.Dictionary")  
   'oDict.comparemode = 1  
   s = "qqq"  
   ss = "QQQ"  
   oDict.Item(s) = vbNullString  
   If oDict.exists(s) Then MsgBox 1  
   oDict.Item(ss) = vbNullString  
   For Each kk In oDict.keys  
       MsgBox kk  
   Next  
End Sub  
 
Sub ttt()  
   Dim s$, ss$, oArrL As Object, kk  
   Set oArrL = CreateObject("System.Collections.ArrayList")  
   s = "qqq"  
   ss = "QQQ"  
   oArrL.Add s  
   If oArrL.Contains(s) Then MsgBox 1  
   oArrL.Add ss  
   For Each kk In oArrL  
       MsgBox kk  
   Next  
End Sub
 
 
 
#4
05.05.2012 09:24:32
{quote}{login=}{date=04.05.2012 04:39}{thema=Удаление дубликатов через VBA с учетом регистра}{post}видимо нужен макрос?{/post}{/quote}  
необязательно.  
можно обойтись допстолбцом с формулой и автофильтром по этому столбцу.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#5
05.05.2012 13:39:24
А подробнее можно?
 
 
 
#6
05.05.2012 13:42:11
{quote}{login=Hugo}{date=04.05.2012 07:49}{thema=}{post}На словаре нужно делать. Или на System.Collections.ArrayList - но на словаре привычнее.{/post}{/quote}  
Пока для меня это сложновато.    
Скажем у меня 6 столбцов, критерии - первый (в разном регистре) и третий.  
Можно и даже лучше вывести уникальные строки на новый столбец.
 
 
 
#7
05.05.2012 14:08:07
{quote}{login=}{date=05.05.2012 01:39}{thema=Re: Re: Удаление дубликатов через VBA с учетом регистра}{post}А подробнее можно?{/post}{/quote}  
можно.  
но проще показать, чем описывать.  
или мне за вас и файл с примером создать?  
 
у меня одна просьба: когда подготовите и выложите свой пример, не забудьте указать - какой из дубликатов оставлять: первый, последний, любой?  
 
и, вдогонку, предупреждение: я оч.сильно подозреваю, что на "огромной" таблице вариант с формулами будет гораздо медленнее, чем правильно написанный макрос.  
 
кстати, Hugo Вам вопросы задал. нет желания ответить?
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#8
05.05.2012 14:31:59
Я же ответил, что лучше на другой лист.  
 
А про дубликат - это интересное замечание. Там еще есть поле с датой, лучше оставлять вариант с наименьшей датой. Хотя можно просто отсортировать по дате, тогда можно удалять первый дубликат. Так думаю проще.  
Пример сейчас сделаю.
 
 
 
#9
05.05.2012 16:52:47
Вот пример.  
Фильтровать надо по первому и третьему столбцу
 
 
 
#10
05.05.2012 17:07:22
проверяйте.  
 
остаётся первый из дубликатов. фильтр по доп.столбцу, условие фильтра =1.  
отфильтрованный список, выделив только видимые, можно скопировать куда пожелаете.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
 
 
#11
05.05.2012 17:29:59
Умно! Даже здорово! Спасибо!
 
 
 
#12
05.05.2012 18:10:10
Так что там с регистром?  
Оба кода оставляют первую встреченную пару, с учётом региста ( в первом вариантн если раскомментировать строку .CompareMode = 1, то регистр учитываться не будет).  
Использовал тот же алгоритм, что в примерах выше.  
 
Option Explicit  
 
Sub tt()  
   Dim a(), i&, ii&, x As Byte, tmp$  
   a = [a1].CurrentRegion.Value
   ReDim b(1 To UBound(a), 1 To 6)  
   With CreateObject("Scripting.Dictionary")  
       '.CompareMode = 1  
 
       For i = 1 To UBound(a)  
           tmp = a(i, 1) & "|" & a(i, 3)  
           If Not .exists(tmp) Then  
               .Item(tmp) = vbNullString  
               ii = ii + 1  
               For x = 1 To 6: b(ii, x) = a(i, x): Next  
           End If  
       Next  
   End With  
 
   Workbooks.Add(xlWBATWorksheet).Sheets(1).[a1].Resize(ii, 6) = b
 
End Sub  
 
Sub ttt()  
   Dim a(), i&, ii&, x As Byte, tmp$  
   a = [a1].CurrentRegion.Value
   ReDim b(1 To UBound(a), 1 To 6)  
 
 
   With CreateObject("System.Collections.ArrayList")  
 
       For i = 1 To UBound(a)  
           tmp = a(i, 1) & "|" & a(i, 3)  
           If Not .Contains(tmp) Then  
               .Add (tmp)  
               ii = ii + 1  
               For x = 1 To 6: b(ii, x) = a(i, x): Next  
           End If  
       Next  
   End With  
 
   Workbooks.Add(xlWBATWorksheet).Sheets(1).[a1].Resize(ii, 6) = b
 
End Sub
 
 
 
#13
05.05.2012 18:14:30
Извиняюсь - уже забыл, что основное требование - учитывать регистр.. :)
 
 
 
#14
06.05.2012 15:20:36
Дома принципиально не держу эксель и так в него пялюсь по 12 часов в день, так что 10 числа проверю.  
 
Спасибо большое!
 
 
 
#15
10.05.2012 17:27:01
Hugo, а если столбцов станет не 6, а 10?  
 
В скрипте заменить 6 на 10?
 
 
 
#16
10.05.2012 17:33:34
Да. Шире делаем массив, больше перекладываем, шире выгружаем.  
Ещё проследите за [a1].CurrentRegion.Value - диапазон должен быть без пустых строк/столбцов.
 
 
 
#17
10.05.2012 18:59:34
Спасибо!
 
 
 
Страницы: 1
Читают тему
Наверх