powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Удаление цветных строк в Excel
4 сообщений из 4, страница 1 из 1
Удаление цветных строк в Excel
    #34395711
Окак
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Нужно найти первую строку выделенную цветом 32 и только после нее начать удалять все строки выделенные цветом 16. Не подскажите как это сделать?
...
Рейтинг: 0 / 0
Удаление цветных строк в Excel
    #34395952
andMegaM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Попробуй этот код
Код: 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
Удаление цветных строк в Excel
    #34399304
sergeyvg
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
можно так
Код: 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
Удаление цветных строк в Excel
    #34399941
Окак
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Я сделал так:
Код: 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
4 сообщений из 4, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Удаление цветных строк в Excel
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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