Страницы: 1
RSS
VBA - работа с RANGE
 
Была задача облегчить пользователю нахождение повторяющихся позиций на диапазоне(не все юзеры могли пользоваться =СЧЁТЕСЛИ). Сообразил следующий макрос:  
 
Sub SerchDuplicates()  
'Делает заливку повторяющихся значений  
Dim i As Range  
On Error Resume Next  
 'вызываем InputBox для явного указания диапазона  
Set Userrange = Application.InputBox(Prompt:="Target range", Title:="Duplicates search", Default:=DefaultRange, Type:=8)    
 'преобразуем выбранный диапазов в выбранный+используемый  
Set Userrange = Intersect(Userrange, ActiveSheet.UsedRange)    
 'снимаем расцветку с целевого диапазона  
Userrange.Interior.Pattern = xlNone    
  For Each i In Userrange  
   If Application.WorksheetFunction.CountIf(Userrange, i) > 1 Then  
    i.Interior.Color = 65535  
   End If  
  Next i  
End Sub  
 
Но потом пришло в голову, что если повторяющихся занчений много, было бы полезно ввести заливку одинаковым цветом только для одинаковых позиций, и тут возникли трудности. Ни при создании коллекции, ни при создании ренджа не работало в цикле следующее:  
 
tcells.add(i) 'для Collection  
set trange = union(trange,i) 'для Range  
 
В чём причина?
 
коллекцию инициализировали?  
 
диапазон инициализировали?
Живи и дай жить..
 
Ты имеешь в виду было ли Dim tcells as Collection и Dim trange as Range ? Если это - то объявлял эти переменные.
 
{quote}{login=Inoxodec}{date=27.05.2011 01:36}{thema=}{post}Ты имеешь в виду было ли Dim tcells as Collection и Dim trange as Range ? Если это - то объявлял эти переменные.{/post}{/quote}  
 
{quote}{login=Inoxodec}{date=27.05.2011 01:36}{thema=}{post}Ты имеешь в виду было ли Dim tcells as Collection и Dim trange as Range ? Если это - то объявлял эти переменные.{/post}{/quote}  
 
 
нет, это объявление.. обычные переменные при этом и инициализируются, но объектные нет.  
 
нужно set col as new collection  
 
и set r=Userrange.cellls(1)
Живи и дай жить..
 
Спасибо The_Prist, if помог. Не работало так, что после прохождения цикла коллекция и рендж были пустыми. Т.е. даже если ставил пометку, то во время компиляции я попадал на строку добавления в коллекцию или ренджа, но оно туда не добавлялось. Не хочется вот только еще один if в цикл запихивать. Боюсь, что если выделят всю книгу макрос может медленно работать.
 
The_Prist, if else на каждом шагу в цикле негуд  
 
не всегда это возможно, но как раз в этом случае - см пред пост
Живи и дай жить..
 
А как выкинуть из диапазона ячейку? Тогда можно было бы обойтись одним IF–ом. Можно было бы проводить проверку на уникальность, и если ячейка уникальна - то выкинуть её из диапазона.
 
и так один if..  
 
вы все ответы читаете?  
 
set trange=Userrange.cells(1)  
for each i in Userrange  
if i..  then set trange=union(trange,i)  
next
Живи и дай жить..
 
{quote}{login=слэн}{date=27.05.2011 02:05}{thema=}{post}The_Prist, if else на каждом шагу в цикле негуд{/post}{/quote}  
Оценим вклад негуда? :-)  
 
Sub Test()  
   
 Dim t0!, t!, i&, rng As Range  
 Const N& = 1000000  
     
 ' Время только за счет цикла  
 t0 = Timer  
 For i = 1 To N  
 Next  
 t0 = Timer - t0  
     
 ' Время цикла + время на If rng Is Nothing  
 t = Timer  
 For i = 1 To N  
   If rng Is Nothing Then  
   Else  
   End If  
 Next  
 t = Timer - t - t0  
   
 Debug.Print Round(t, 3) ' 16 мс / 1млн.опер = гуд?  
     
End Sub
 
ZVI  
не гуд в ``8 раз медленнее :(, хотя общая скорость приемлема
 
Как вариант, я использовал как то такой метод: присваивал первое значение set Rng=range("a1"), и в конце процедуры возвращал нужный параметр или значение range("a1")  
Дмитрий.
Спасибо
 
{quote}{login=}{date=29.05.2011 05:51}{thema=}{post}ZVI  
не гуд в ``8 раз медленнее :(, хотя общая скорость приемлема{/post}{/quote}  
16 миллисекунд на 1 миллион операций медленнее чего в 8 раз?
Страницы: 1
Читают тему
Наверх