Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Макрос для сравнения столбцов
 
#1
05.03.2012 19:05:07
Всем добрый день. Вопрос такой. Есть макрос, который сравнивает данные первого столбца с данными второго столбца, и если данные во втором столбце повторяются, он их красит. Так вот такой вопрос, как можно исправить данный макрос, что бы он красил только второе повторение, третье и так далее.  
 
Sub DeleteDubls()  
Const intDataCol = 5  
Const intMaxRow = 140  
   Dim i%, j%  
   Dim strValue1$, strValue2$  
   For i = 2 To intMaxRow - 1  
       strValue1 = Trim(Cells(i, intDataCol))  
       For j = i + 1 To intMaxRow  
           strValue2 = Trim(Cells(j, intDataCol))  
           If StrComp(strValue1, strValue2, vbTextCompare) = 0 Then  
               Cells(j, intDataCol).Interior.ColorIndex = 4  
           End If  
       Next  
   Next  
End Sub  
 
Файл с тем как должно выглядеть прикреплен
 
 
 
#2
05.03.2012 19:07:39
Извините пожалуйста, макрос не тот(поздно, туплю). Вот истинный  
Sub DeleteDubls()  
Const intDataCol = 1  
Const intMaxRow = 9  
Const intDataCol1 = 2  
Const intMaxRow1 = 9  
   Dim i%, j%  
   Dim strValue1$, strValue2$  
   For i = 2 To intMaxRow - 1  
       strValue1 = Trim(Cells(i, intDataCol))  
       For j =  1 To intMaxRow1  
           strValue2 = Trim(Cells(j, intDataCol1))  
           If StrComp(strValue1, strValue2, vbTextCompare) = 0 Then  
               Cells(j, intDataCol).Interior.ColorIndex = 4  
           End If  
       Next  
   Next  
End Sub
 
 
 
#3
05.03.2012 19:11:15
Поделитесь по секрету, вы всерьез считаете, что скачать с интернета пустую книгу проще, чем создать?
 
 
 
#4
05.03.2012 19:12:39
на лету ))  
Sub DeleteDubls()  
Const intDataCol = 1  
Const intMaxRow = 9  
Const intDataCol1 = 2  
Const intMaxRow1 = 9  
Dim i%, j%, k as long  
Dim strValue1$, strValue2$  
For i = 2 To intMaxRow - 1  
strValue1 = Trim(Cells(i, intDataCol))  
For j = 1 To intMaxRow1  
strValue2 = Trim(Cells(j, intDataCol1))  
If StrComp(strValue1, strValue2, vbTextCompare) = 0 Then  
k=k+1  
if k>0 then Cells(j, intDataCol).Interior.ColorIndex = 4  
End If  
Next  
k=0  
Next  
End Sub
Редко но метко ...
 
 
 
#5
05.03.2012 19:14:00
Нужно заменить  
if k>0 then ...  
на  
if k>1 then ...
Редко но метко ...
 
 
 
#6
05.03.2012 19:17:33
Я тоже письмо написал:)  
 
В чём смысл аттачмента?  
 
Вообще такое нужно делать на словаре и массивах.  
Но и такой код на небольших объёмах можно применять.  
А чтоб не красило первое значение - добавьте переменную типа boolean.  
Перед очередным внутренним циклом скидываете на false, при повторе проверяете переменную - если false, то переводите в true, иначе красите.  
Т.к. примера данных нет - то в коде реализовать не стал, т.к.проверить не на чем.  
 
Пока писал, Антон уже почти так и реализовал.
 
 
 
#7
05.03.2012 19:25:00
Большое спасибо. Да есть необходимость, описывать долго и нудно. А вопрос такой, допустим при больших объемах(к примеру сравнить два столбца по сорок тыщ) обработка компьютера макросом занимает достаточно много времени, словарем и массивами быстрее?
 
 
 
#8
05.03.2012 20:34:05
40000 на 40000 думаю секунды 2-3 будет сверять - это если не красить, а отбирать в другое место.  
Основное время займёт именно окраска - а зачем она? Думаю удобнее сразу получить список.
 
 
 
#9
05.03.2012 20:47:55
Вот пример (искал на форуме - не нашёл такого простого готового):
 
 
 
#10
05.03.2012 21:00:36
Хм, интересно, буду знать. Надо будет научиться со словарем работать. А крашу затем, что не знаю, что нужно будет делать с этими земельными участками. Иногда нужно удалить повторяющиеся, иногда нужно посмотреть данные у повторяющихся, совпадают характеристики какие нибудь или нет, или их просто нужно начальству показать, ну и тп. Такого, что бы вывести повторения на третий лист пока не попадалась, хотя для общего развития нужно будет освоить))). Завтра в гугле поищу как со словарем работать.
 
 
 
#11
05.03.2012 21:20:34
А чего искать - вот оно: http://www.excelworld.ru/forum/3-313-1  
Вместо покраски удобно и быстро формировать массив результатов из единиц (вместо копирования) и выгружать в столбик рядом - по этим единицам можно фильтровать или сортировать.  
Код меняется незначительно (см. файл).  
 
ReDim c(1 To UBound(a), 1 To 1)  
 
   For i = 1 To UBound(a)  
     If .exists(a(i, 1)) Then c(i, 1) = 1  
   Next
 
 
 
#12
05.03.2012 21:33:07
Огромное спасибо, очень полезная вещь, по крайне мере в некоторых случаях мне точно жизнь облегчит)))
 
 
 
Страницы: 1
Читают тему
Наверх