Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Помогите оптимизировать макрос TreeView
 
#1
27.06.2010 16:29:49
Нужна ваша помощь в оптимизировании Макроса.    
В кратце:  
Существует база Excel в которой все строки подчинены друг другу по принципу каталогов как в Проводнике Windows. Количество уровней вложений может быть, скажем, неограниченное.  
 
Задача такая:    
Найти все строки нижележащих уровней и маркировать их цифрой "1".  
Я написал макрос, но количество уровней в нем ограниченное(в данном примере 3)  
Есть ли у кого какие идеи, ну не писать же 100 раз один и тот же макрос для каждого уровня.  
Пример с готовым макросом прикрепил.
 
 
 
#2
27.06.2010 16:35:09
5 минут искал макрос в вашем файле. не нашёл...  
 
да и не совсем понятно, как и какие строки маркировать  
Обязательно макросом, или можно формулой?  
 
Покажите пример - что есть ДО, и что надо ПОСЛЕ  
и про свой макрос не забудьте
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#3
27.06.2010 16:38:41
Извиняюсь, видимо когда сохранял он не сохранился в книге. Сейчас напишу заново
 
 
 
#4
27.06.2010 16:49:40
Файл перезалил
 
 
 
#5
27.06.2010 17:11:07
Вот сам макрос если кто не хочет качать файл  
 
component = Cells(2, 1)  
Cells(2, 6) = 1  
 
For Each zeller In Range("C2", "C8")  
If zeller = component Then  
Cells(zeller.Row, 6) = 1  
component1 = Cells(zeller.Row, 1)  
 
   For Each zeller1 In Range("C2", "C8")  
   If zeller1 = component1 Then  
   Cells(zeller1.Row, 6) = 1  
   component2 = Cells(zeller1.Row, 1)  
 
       For Each zeller2 In Range("C2", "C8")  
       If zeller2 = component2 Then  
       Cells(zeller2.Row, 6) = 1  
       component3 = Cells(zeller2.Row, 1)  
 
           '''''''  
           '''''''  
 
       End If  
       Next zeller2  
 
   End If  
   Next zeller1  
 
End If  
Next zeller
 
 
 
#6
27.06.2010 17:38:51
Н-да. С такой постановкой вопроса... Достаточно одного цикла. Будет определять, что строка не принадлежит к наивысшему уровню и маркировать ее единичкой. А если честно, я ни фига не понял. Мож, как-то переформулировать вопрос?
Я сам - дурнее всякого примера! ...
 
 
 
#7
27.06.2010 17:52:58
{quote}{login=KuklP}{date=27.06.2010 05:38}{thema=}{post}Н-да. С такой постановкой вопроса... Достаточно одного цикла. Будет определять, что строка не принадлежит к наивысшему уровню и маркировать ее единичкой. А если честно, я ни фига не понял. Мож, как-то переформулировать вопрос?{/post}{/quote}  
 
Пример: Это каталог запчастей в нем показана иерархия, например дверь состоит из стеклоподъемника, стеклоподъемник состоит блока управления. Так в этом примере надо найти все составный части этой двери и маркировать их.  
 
В файле видно одни компоненты ссылаются на другие. Надеюсь это объяснение помогло
 
 
 
#8
27.06.2010 18:01:44
вот что получилось:  
 
Sub test()  
   Dim component As Range: Set component = [a2] ' исходный уровень
   Range("f:f").ClearContents    ' очиска прежних результатов  
   component.EntireRow.Cells(6) = 1  
   Dim cell As Range, ra As Range: Application.ScreenUpdating = False  
   Set ra = Range(component(2, 3), Range("c" & Rows.Count).End(xlUp))  
   Dim SearchRange As Range, CurrentLevel As Range: Set SearchRange = ActiveSheet.UsedRange.Columns(1)  
   For Each cell In ra.Cells  
       Set CurrentLevel = Nothing: Set CurrentLevel = SearchRange.Find(cell, , , xlWhole)  
       If Not CurrentLevel Is Nothing Then  
           If CurrentLevel.EntireRow.Cells(6) = 1 Then cell.EntireRow.Cells(6) = 1  
       End If  
   Next cell  
End Sub  
 
 
Пример в файле: http://excelvba.ru/XL_Files/Sample__27-06-2010__20-00-00.zip  
 
Единствееное, что вам надо менять в макросе - это адрес ячейки в строке    
Set component = [a2]
 
Можете и так сделать:  
Dim component As Range: Set component = ActiveCell.EntireRow.Cells(1)        
' исходный уровень - строка с выделенной ячейкой
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#9
27.06.2010 18:10:28
{quote}{login=EducatedFool}{date=27.06.2010 06:01}{thema=}{post}вот что получилось:  
 
Sub test()  
   Dim component As Range: Set component = [a2] ' исходный уровень
   Range("f:f").ClearContents    ' очиска прежних результатов  
   component.EntireRow.Cells(6) = 1  
   Dim cell As Range, ra As Range: Application.ScreenUpdating = False  
   Set ra = Range(component(2, 3), Range("c" & Rows.Count).End(xlUp))  
   Dim SearchRange As Range, CurrentLevel As Range: Set SearchRange = ActiveSheet.UsedRange.Columns(1)  
   For Each cell In ra.Cells  
       Set CurrentLevel = Nothing: Set CurrentLevel = SearchRange.Find(cell, , , xlWhole)  
       If Not CurrentLevel Is Nothing Then  
           If CurrentLevel.EntireRow.Cells(6) = 1 Then cell.EntireRow.Cells(6) = 1  
       End If  
   Next cell  
End Sub  
 
 
Пример в файле: http://excelvba.ru/XL_Files/Sample__27-06-2010__20-00-00.zip  
 
Единствееное, что вам надо менять в макросе - это адрес ячейки в строке    
Set component = [a2]
 
Можете и так сделать:  
Dim component As Range: Set component = ActiveCell.EntireRow.Cells(1)        
' исходный уровень - строка с выделенной ячейкой{/post}{/quote}  
 
Спасибо, все работает, теперь осталось понять принцип, буду разбираться
 
 
 
Страницы: 1
Читают тему
Наверх