Страницы: 1
RSS
VBA - удаление определенных ячеек
 
Помогите пожалуйста с макросом, целый день пытаюсь что-то подобное найти.

Есть неизвестное число таблиц, каждая находятся внутри определенного диапазона, диапазоны нужно прописать в макросе. Например, в прикрепленном файле, 4 таблицы (B3:I52) (B55:I104) (J3:Q52) (J55:Q104).

1. Нужно удалить содержимое двух ячеек левее слова "Розовый", для наглядности выделил розовым.
2. Нужно удалить все ячейки под словом "Красный", но в пределах диапазона, в примере - это удалить (J18:Q52) для диапазона (J3:Q52) и (B101:I104) для диапазона (B3:I52).

Слова "Розовый" и "Красный" бывают только в 5 и 8 колонках в пределах своего диапазона. Цвета в примере носят только информативных характер )
 
ТЗ - в платном разделе. Здесь помощь по конкретным вопросам.
 
Тогда пожалуйста подскажите, как сделать поиск и последующее удаление внутри определенного диапазона средствами VBA ?
 
Цитата
ff48 написал:
Нужно удалить все ячейки под словом "Красный"
Если очистим (в диапазоне) всё, что ниже ячейки N17, то пропадёт и "Розовый" в ячейке N47.
 
Это не важно, у красного приоритет )
 
Но тогда не будет возможности выполнить это:
Цитата
ff48 написал:
удалить содержимое двух ячеек левее слова "Розовый",
 
Дело в том что "Розовый" и "Красный" пересекаются не часто. Иногда их вообще в таблице нет. И как я понимаю работу скрипта, в случае если "Розовый" находится ниже "Красного". Сначала скрипт удаляет 2 ячейки слева от "Розовый", потом удаляет все что ниже "Красный", и если там оказался "Розовый", то и его удаляет.
 
Погуглив удалось собрать почти то что нужно. С "Розовый" проблем нет, а вот с "Красным" есть. Например в перезалитом примере, 2 таблицы, A3:H24 и A26:H47. Если во 2й таблице A26:H47 нет слова "Красный", то все работает ок, если есть то макрос удаляет нужную часть 1й и полностью 2ю таблицу . Как сказать макросу чтобы он не лез во 2ю таблицу ?

И подскажите что написать вместо With Sheets("Test 1") чтобы этот макрос применялся ко всей книге в целом, если это возможно.
Код
Sub Delete_Red()
'
Dim i&
Dim n As Boolean
n = False
With Sheets("Test 1")
    For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
' From A3 to H24
        If .Cells(i, 5) = "Розовый" Then
            With .Range(.Cells(i, 3), .Cells(i, 4))
                .ClearContents
            End With
        End If
        If .Cells(i, 8) = "Розовый" Then
            With .Range(.Cells(i, 6), .Cells(i, 7))
                .ClearContents
            End With
        End If
        If .Cells(i, 5) = "Красный" Or .Cells(i, 8) = "Красный" Then
            With .Range(.Cells(i + 1, 1), Cells(24, 8))
                .ClearContents
            End With
        End If
        
 ' From A26 to H47
 
        If .Cells(i, 5) = "Розовый" Then
            With .Range(.Cells(i, 3), .Cells(i, 4))
                .ClearContents
            End With
        End If
        If .Cells(i, 8) = "Розовый" Then
            With .Range(.Cells(i, 6), .Cells(i, 7))
                .ClearContents
            End With
        End If
        If .Cells(i, 5) = "Красный" Or .Cells(i, 8) = "Красный" Then
            With .Range(.Cells(i + 1, 1), Cells(47, 8))
                .ClearContents
            End With
        End If
    Next i
End With
End Sub
 
В файле, ячейки, которые должны быть очищены, выделены цветом. Желтым и голубым соответственно. Для наглядности
Код
Sub RedPink()
Dim iPink As Range, iRed As Range
Dim iAdr$
arrRange = Array("B3:I52", "B55:I104", "J3:Q52", "J55:Q104")
For I = LBound(arrRange) To UBound(arrRange)
    With Range(arrRange(I))
    Set iPink = .Find("Розовый")
    If Not iPink Is Nothing Then
      iAdr = iPink.Address
      Do
        iPink.Offset(, -2).Resize(, 2).ClearContents
        Set iPink = .FindNext(iPink)
      Loop While Not iPink Is Nothing And iPink.Address <> iAdr
    End If
    iAdr = ""
    Set iRed = .Find("Красный")
    If Not iRed Is Nothing Then
      iAdr = iRed.Address
      Do
        iRed.Offset(1).Resize(.Rows.Count - iRed.Row + .Row - 1).ClearContents
        Set iRed = .FindNext(iRed)
      Loop While Not iRed Is Nothing And iRed.Address <> iAdr
    End If
    End With
Next
End Sub
Согласие есть продукт при полном непротивлении сторон
 
Цитата
ff48 написал: И подскажите что написать вместо With Sheets("Test 1")
Вместо этого нужно делать цикл по листам
Скрытый текст
Изменено: Sanja - 17.08.2019 08:11:25
Согласие есть продукт при полном непротивлении сторон
 
Sanja, Спасибо, единственное, удалять нужно не только в колонке под "Красный", а во всех 8 колонках диапазона, т.е. очистить все от "Красный + 1" до конца рейнджа. Пытался менять эту часть, ничего не вышло."

Код
Do
        iRed.Offset(1).Resize(.Rows.Count - iRed.Row + .Row - 1).ClearContents
Изменено: ff48 - 17.08.2019 14:57:00
 
Как теперь тему обзовем (ближе к теме)?
 
Цитата
vikttur написал:
Как теперь тему обзовем (ближе к теме)?
Ну вроде все вопросы в рамках темы и правил, извините если что-то не так.

Мои знания около нулевые, но удалось понять, что в этом коде нужно указать первую колонку диапазона.
Код
iRed.Offset(1, "Первая колонка" ).Resize(.Rows.Count - iRed.Row + .Row - 1, .Columns.Count).ClearContents

Подскажите пожалуйста, что нужно вместо "Первая колонка" вставить.
Изменено: ff48 - 17.08.2019 17:30:11
 
Если правильно понял
Согласие есть продукт при полном непротивлении сторон
 
Sanja, То что нужно, спасибо огромное.
Страницы: 1
Наверх