Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Удаление цветных строк в Excel / 4 сообщений из 4, страница 1 из 1
16.03.2007, 13:46:53
    #34395711
Окак
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление цветных строк в Excel
Нужно найти первую строку выделенную цветом 32 и только после нее начать удалять все строки выделенные цветом 16. Не подскажите как это сделать?
...
Рейтинг: 0 / 0
16.03.2007, 14:38:21
    #34395952
andMegaM
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление цветных строк в Excel
Попробуй этот код
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
For i =  1  To ActiveCell.SpecialCells(xlLastCell).Row
 If Cells(i,  1 ).Interior.ColorIndex =  32  Then
 firstAddress = Cells(i +  1 ,  1 ).Address(RowAbsolute:=False)
 fir = Mid(firstAddress,  3 )
 End If
 
 Next i

Cells( 1 ,  1 ).Value = firstAddress
Cells( 1 ,  2 ).Value = fir

tt = fir
label1:
      For i = tt To ActiveCell.SpecialCells(xlLastCell).Row
          
         If Cells(i,  1 ).Interior.ColorIndex =  16  Then
          Rows(i).Delete
              tt = i
              
             GoTo label1
          End If
    Next i
...
Рейтинг: 0 / 0
19.03.2007, 09:50:22
    #34399304
sergeyvg
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление цветных строк в Excel
можно так
Код: 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.
25.
Sub Test()
Dim RWork As Range, RDel As Range, RRow As Long
  Application.FindFormat.Interior.ColorIndex =  32 
  Set RWork = Range("A:A").Find(What:="", LookIn:=xlFormulas, LookAt:=xlPart, _
    SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True)
  If Not RWork Is Nothing Then
    Set RDel = Nothing
    Application.FindFormat.Interior.ColorIndex =  16 
    Do
      Set RWork = Range("A" & RWork.Row & ":A65536").Find(What:="", _
        SearchDirection:=xlNext, SearchFormat:=True)
      If RWork Is Nothing Then
        Exit Do
      Else
        If RDel Is Nothing Then
          Set RDel = RWork
        Else
          If RRow = RWork.Row Then Exit Do
          Set RDel = Union(RDel, RWork)
        End If
        RRow = RWork.Row
      End If
    Loop
    If Not RDel Is Nothing Then RDel.EntireRow.Delete
  End If
End Sub 'Test
...
Рейтинг: 0 / 0
19.03.2007, 12:56:40
    #34399941
Окак
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Удаление цветных строк в Excel
Я сделал так:
Код: 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.
Dim r As Range

'Ищем первую синию строку
Cells( 1 ,  1 ).Select
Application.FindFormat.Interior.ColorIndex =  32 
Set r = Cells.Find(What:="*", After:=ActiveCell, SearchFormat:=True)
r.Select
Dim rw As Integer
rw = r.Row
Application.FindFormat.Clear

'Удаляем все серые ниже нее
Application.FindFormat.Interior.ColorIndex =  16 
Do
    Set r = Cells.Find(What:="*", After:=ActiveCell, SearchFormat:=True)
    If Not r Is Nothing Then
        If r.Row > rw Then
            r.EntireRow.Delete
        Else
            Set r = Nothing
        End If
    End If
Loop Until r Is Nothing
Application.FindFormat.Clear
Все большое спасибо!
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Удаление цветных строк в Excel / 4 сообщений из 4, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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