Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Раскраска в цикле / 12 сообщений из 12, страница 1 из 1
03.09.2007, 15:45
    #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:46
    #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, 16:57
    #34772437
Worobjoff
Worobjoff
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Раскраска в цикле
xRange.Interior.Color
или
xRange.Interior.ColorIndex
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
03.09.2007, 17:31
    #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, 18:21
    #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:37
    #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
| Ответить | Цитировать | Написать  
04.09.2007, 15:39
    #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:59
    #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, 16:24
    #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:31
    #34775198
VladConn
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Раскраска в цикле
Там у вас не указывается, что делать, если не первый уровень. То есть, или нужен else или как у меня в коде, без If.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
04.09.2007, 16:44
    #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
| Ответить | Цитировать | Написать  
21.09.2007, 11:24
    #34817017
light_ret
light_ret
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Раскраска в цикле
Да, действительно так прикольней будет! :)
Количество строк там не очень большое (около 100), поэтому я особо не парился с правильностью и оптимизацией.
Теперь сделаю как Вы написали, все же лучше будет.
Спасибо большое!!!!!! :)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Раскраска в цикле / 12 сообщений из 12, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 328ms
Закрыть
start [/forum/topic.php?fid=60&mobile=1&tid=2163372]:
 0ms
get settings:
 5ms
get forum list:
 14ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 42ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 43ms
get tp. blocked users:
 1ms
others: 208ms
total:  328ms
x
x
Закрыть


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