ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Раскраска в цикле
12 сообщений из 12, страница 1 из 1
Раскраска в цикле
    #34772114
light_ret
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
light_ret
Участник
Здравствуйте!!
У меня есть задача: есть дерево (3х уровневое) отстроенное в екселе и необходимо все записи 1 и 2-го уровней сделать шрифт жырным.
В екселе есть столбец, в котором прописан уровень той записи на которой мы стоим(прикрепил).
у меня даже есть рендж по которому я могу сделать цикл
Public Sub GroupAll(N Num1 Num2 As Integer)Dim Adr1(10) Adr2(10) Zn(10) As StringDim xRange As RangeFirstCell = Cells(Num1 N).Address()LastCell = Cells(Num2 N).Address()i = 0Adr1(i) = FirstCell: Adr2(i) = FirstCell Zn(i) = Range(Adr1(i)).Value ActiveSheet.Outline.SummaryRow = xlAbove For Each xRange In Range(FirstCell LastCell)----------------- NextEnd Sub
А вот покрасить не могу.
Подскажите как это можно сделать в этом цикле.
Большое спасибо за помощь!!!!!!!!!!!!!1
...
Рейтинг: 0 / 0
03.09.2007, 15:45
| Ответить | Цитировать | Написать  
Раскраска в цикле
    #34772118
light_ret
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
light_ret
Участник
Извиняюсь!!!
Постоянно забываю правельные теги
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
 Public Sub GroupAll(N, Num1, Num2 As Integer)
Dim Adr1( 10 ), Adr2( 10 ), Zn( 10 ) As String
Dim xRange As Range

FirstCell = Cells(Num1, N).Address()
LastCell = Cells(Num2, N).Address()



i =  0 
Adr1(i) = FirstCell: Adr2(i) = FirstCell  Zn(i) = Range(Adr1(i)).Value    
ActiveSheet.Outline.SummaryRow = xlAbove 

For Each xRange In Range(FirstCell, LastCell)
-----------------
 Next



End Sub
...
Рейтинг: 0 / 0
03.09.2007, 15:46
| Ответить | Цитировать | Написать  
Раскраска в цикле
    #34772437
Фотография Worobjoff
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Worobjoff
Участник
xRange.Interior.Color
или
xRange.Interior.ColorIndex
...
Рейтинг: 0 / 0
03.09.2007, 16:57
| Ответить | Цитировать | Написать  
Раскраска в цикле
    #34772552
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Не особо понял вопрос, но может так

Код: plaintext
If xRange.value =  1  or xRange.value =  2  Then Range(xRange, xRange.Offset(, Columns.Count -  1 ).End(xlToLeft)).Font.Bold = True
...
Рейтинг: 0 / 0
03.09.2007, 17:31
| Ответить | Цитировать | Написать  
Раскраска в цикле
    #34772683
light_ret
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
light_ret
Участник
DeggasadНе особо понял вопрос, но может так

Код: plaintext
If xRange.value =  1  or xRange.value =  2  Then Range(xRange, xRange.Offset(, Columns.Count -  1 ).End(xlToLeft)).Font.Bold = True


На самом деле все намного проще оказалось - я сам запутался и вас звпутал. :)
Решение оказалось таким:
Код: plaintext
1.
2.
3.
4.
5.
6.
For i =  7  To Range("sql").Count +  7 
     If Cells(i,  2 ).Value =  1  Then
       For j =  1  To Range("sql").Columns.Count
        Cells(i, j).Font.Bold = True
       Next
     End If
Next

Большое спасибо за подсказки!!!!!!
...
Рейтинг: 0 / 0
03.09.2007, 18:21
| Ответить | Цитировать | Написать  
Раскраска в цикле
    #34772716
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
light_ret

На самом деле все намного проще оказалось - я сам запутался и вас звпутал. :)
Решение оказалось таким:
Код: plaintext
1.
2.
3.
4.
5.
6.
For i =  7  To Range("sql").Count +  7 
     If Cells(i,  2 ).Value =  1  Then
       For j =  1  To Range("sql").Columns.Count
        Cells(i, j).Font.Bold = True
       Next
     End If
Next

Большое спасибо за подсказки!!!!!!

Ничё себе проще - перебор по всему столбцу.
Если ты для всей строки хочешь, тогда уж так:
Код: plaintext
1.
2.
3.
4.
For i =  7  To Range("sql").Count +  7 
     If Cells(i,  2 ).Value =  1  Then
        If Cells(i,  2 ).Value =  1  Then Cells(i,  2 ).EntireRow.Font.Bold = True
     End If
Next
...
Рейтинг: 0 / 0
03.09.2007, 18:37
| Ответить | Цитировать | Написать  
Раскраска в цикле
    #34774904
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VladConn
Участник
Не понял, почему:

Код: plaintext
1.
If Cells(i,  2 ).Value =  1  Then
        If Cells(i,  2 ).Value =  1  Then

Кто-то пояснит, зачем проверять два раза одно и тоже условие...
...
Рейтинг: 0 / 0
04.09.2007, 15:39
| Ответить | Цитировать | Написать  
Раскраска в цикле
    #34774998
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VladConn
Участник
Кроме того, не всегда хорошо менять фонт во всей строке ради того, чтобы избежать цикла по колонкам. Можно и без цикла по колонкам и без всей строки. А также и без If:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
Private Sub CommandButton1_Click()
    MakeLevelsOneAndTwoBold "A",  14 ,  19 , "B", "D"
End Sub

Private Sub MakeLevelsOneAndTwoBold(ByVal pstrLevelCol As String, _
                                                            ByVal plngFirstTreeRow As Long, _
                                                            ByVal plnLastTreeRow As Long, _
                                                            ByVal pstrFirstTreeCol As String, _
                                                            ByVal pstrLastTreeCol As String)
                                                            
    Dim objTreeRange  As Range
    Dim lngRow As Long
   
        For lngRow = plngFirstTreeRow To plnLastTreeRow
        
            With ThisWorkbook.Worksheets( 1 )
                Set objTreeRange = .Range(pstrFirstTreeCol & CStr(lngRow) & ":" & pstrLastTreeCol & CStr(lngRow))
        
                objTreeRange.Font.Bold = .Range(pstrLevelCol & CStr(lngRow)) =  1  Or _
                                                       .Range(pstrLevelCol & CStr(lngRow)) =  2 
            End With
            
        Next lngRow
    
End Sub
...
Рейтинг: 0 / 0
04.09.2007, 15:59
| Ответить | Цитировать | Написать  
Раскраска в цикле
    #34775157
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
VladConnНе понял, почему:

Код: plaintext
1.
If Cells(i,  2 ).Value =  1  Then
        If Cells(i,  2 ).Value =  1  Then

Кто-то пояснит, зачем проверять два раза одно и тоже условие...

Хрень конечно ошибся.
А вообще если sql - это именованный диапазон с данными структуры, во втором столбце которого находятся цифры с номером уровня, то выделить первый уровень так

Код: plaintext
1.
2.
3.
4.
5.
6.
Sub test1()
  With Range("sql")
    For i =  1  To .Rows.Count
        If .Cells(i,  2 ).Value =  1  Then .Rows(i).Font.Bold = True
    Next
  End With
End Sub

Код: plaintext
1.
2.
3.
4.
Sub test2()
    For Each iRow In Range("sql").Rows
        If iRow.Cells( 2 ).Value =  1  Then iRow.Font.Bold = True
    Next
End Sub

Второй мне кажется более правильным
...
Рейтинг: 0 / 0
04.09.2007, 16:24
| Ответить | Цитировать | Написать  
Раскраска в цикле
    #34775198
Фотография VladConn
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VladConn
Участник
Там у вас не указывается, что делать, если не первый уровень. То есть, или нужен else или как у меня в коде, без If.
...
Рейтинг: 0 / 0
04.09.2007, 16:31
| Ответить | Цитировать | Написать  
Раскраска в цикле
    #34775266
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
VladConnТам у вас не указывается, что делать, если не первый уровень. То есть, или нужен else или как у меня в коде, без If.
Согласен так прикольней
Код: plaintext
1.
2.
3.
4.
Sub test3()
    For Each iRow In Range("sql").Rows
        iRow.Font.Bold = iRow.Cells( 2 ).Value =  1 
    Next
End Sub
...
Рейтинг: 0 / 0
04.09.2007, 16:44
| Ответить | Цитировать | Написать  
Раскраска в цикле
    #34817017
light_ret
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
light_ret
Участник
Да, действительно так прикольней будет! :)
Количество строк там не очень большое (около 100), поэтому я особо не парился с правильностью и оптимизацией.
Теперь сделаю как Вы написали, все же лучше будет.
Спасибо большое!!!!!! :)
...
Рейтинг: 0 / 0
21.09.2007, 11:24
| Ответить | Цитировать | Написать  
12 сообщений из 12, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Раскраска в цикле
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&msg=34775157&tid=2163372]:
 0ms
get settings:
 8ms
get forum list:
 14ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 148ms
get topic data:
 7ms
get forum data:
 2ms
get page messages:
 33ms
get tp. blocked users:
 1ms
others: 258ms
total:  477ms
созд. / загр.: 477ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]