Здравствуйте. Помогите с макросами, пожалуйста. Нужно удалить все строки в таблице, в которых столбец С равен нулю. Выделить сроки цветом, в которых столбец G или H пуст.
Прошу сделать двумя отдельными макросами.
Здравствуйте. Помогите с макросами, пожалуйста. Нужно удалить все строки в таблице, в которых столбец С равен нулю. Выделить сроки цветом, в которых столбец G или H пуст.
-=Dj=-, для вопросов о макросах есть своя ветка на форуме. Тему перенесла. Название Вашей темы слишком общее, дайте более конкретно. По Правилам форума: 1 вопрос - 1 тема. Для второго макроса создайте отдельную тему.
-=Dj=-, для вопросов о макросах есть своя ветка на форуме. Тему перенесла. Название Вашей темы слишком общее, дайте более конкретно. По Правилам форума: 1 вопрос - 1 тема. Для второго макроса создайте отдельную тему.Manyasha
Вот есть готовое решение! Если я Вас правильно понял. Чуть подправил по Вас... Попробуйте. Но минус в том, что нумерация строк хромает (и то исправима) А по поводу второго вопроса... так его можно сделать стандартным УФ(Условным Форматированием) [vba]
Код
Sub Макрос() Dim x As Range: Application.ScreenUpdating = False Set x = [C:C].Find(0, , , xlWhole) If Not x Is Nothing Then [C:C].ColumnDifferences(x).EntireRow.Hidden = True ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete Rows.Hidden = False End If End Sub
[/vba]
Вот есть готовое решение! Если я Вас правильно понял. Чуть подправил по Вас... Попробуйте. Но минус в том, что нумерация строк хромает (и то исправима) А по поводу второго вопроса... так его можно сделать стандартным УФ(Условным Форматированием) [vba]
Код
Sub Макрос() Dim x As Range: Application.ScreenUpdating = False Set x = [C:C].Find(0, , , xlWhole) If Not x Is Nothing Then [C:C].ColumnDifferences(x).EntireRow.Hidden = True ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete Rows.Hidden = False End If End Sub
По поводу темы - виноват, извините. а на счет 1 вопрос - 1 тема, так вопрос по сути то один... вот сам нашел решение, макрос один просто изменил условие и действие. Удаление
[vba]
Код
Sub delete() Dim x, i&, delRa As Range x = Range("C1:C" & [a65535].End(xlUp).Row).Value For i = 1 To UBound(x) If x(i, 1) = "0" Then If delRa Is Nothing Then Set delRa = Cells(i, 1) Else Set delRa = Union(Cells(i, 1), delRa) End If End If Next If Not delRa Is Nothing Then delRa.EntireRow.Delete End Sub
[/vba]
Выделение
[vba]
Код
Sub highlighter() Dim x, i&, delRa As Range x = Range("G1:G" & [a65535].End(xlUp).Row).Value For i = 1 To UBound(x) If x(i, 1) = " " Then If delRa Is Nothing Then Set delRa = Cells(i, 1) Else Set delRa = Union(Cells(i, 1), delRa) End If End If Next If Not delRa Is Nothing Then delRa.EntireRow.Interior.Color = 255 End Sub
[/vba]
По поводу темы - виноват, извините. а на счет 1 вопрос - 1 тема, так вопрос по сути то один... вот сам нашел решение, макрос один просто изменил условие и действие. Удаление
[vba]
Код
Sub delete() Dim x, i&, delRa As Range x = Range("C1:C" & [a65535].End(xlUp).Row).Value For i = 1 To UBound(x) If x(i, 1) = "0" Then If delRa Is Nothing Then Set delRa = Cells(i, 1) Else Set delRa = Union(Cells(i, 1), delRa) End If End If Next If Not delRa Is Nothing Then delRa.EntireRow.Delete End Sub
[/vba]
Выделение
[vba]
Код
Sub highlighter() Dim x, i&, delRa As Range x = Range("G1:G" & [a65535].End(xlUp).Row).Value For i = 1 To UBound(x) If x(i, 1) = " " Then If delRa Is Nothing Then Set delRa = Cells(i, 1) Else Set delRa = Union(Cells(i, 1), delRa) End If End If Next If Not delRa Is Nothing Then delRa.EntireRow.Interior.Color = 255 End Sub
Вопросов как раз-таки два, как и пишет Вам модератор и они абсолютно разные. Давайте все темы будем называть "Эксель" и валить в них все, что в голову придет. Что можно будет найти в такой свалке? И код надо оформлять тегами. Знак # на панели редактирования:
Вопросов как раз-таки два, как и пишет Вам модератор и они абсолютно разные. Давайте все темы будем называть "Эксель" и валить в них все, что в голову придет. Что можно будет найти в такой свалке? И код надо оформлять тегами. Знак # на панели редактирования: KuklP
Почему? В новой теме. Решается одной строкой. Да и первый вопрос можно без цикла и короче, просто удалите второй вопрос из топика: [vba]
Код
Sub DeleteNulRows() On Error Resume Next With Intersect(ActiveSheet.UsedRange, Columns(3)) .ColumnDifferences(.Find(0, , xlValues, xlWhole)).EntireRow.Hidden = -1 .SpecialCells(12).EntireRow.Delete .EntireRow.Hidden = 0 End With End Sub
[/vba]
Почему? В новой теме. Решается одной строкой. Да и первый вопрос можно без цикла и короче, просто удалите второй вопрос из топика: [vba]
Код
Sub DeleteNulRows() On Error Resume Next With Intersect(ActiveSheet.UsedRange, Columns(3)) .ColumnDifferences(.Find(0, , xlValues, xlWhole)).EntireRow.Hidden = -1 .SpecialCells(12).EntireRow.Delete .EntireRow.Hidden = 0 End With End Sub
ant6729, По поводу выделения могут возникать проблемы из-за того что образец немного корректировался вручную, на самом деле там стоит пробел в ячейках.
ant6729, По поводу выделения могут возникать проблемы из-за того что образец немного корректировался вручную, на самом деле там стоит пробел в ячейках.-=Dj=-
Добрый вечер, а как удалить все строки, если не содержит? (Например, слово "Вася")
Если нужно, создам новую тему.
Пробую такую запись, но не срабатывает.
[vba]
Код
Sub delete() For x = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 If Cells(x, 4).Value Like "<>*Вася*" Then Rows(x).Delete (xlShiftUp) Next x End Sub
[/vba]
Добрый вечер, а как удалить все строки, если не содержит? (Например, слово "Вася")
Если нужно, создам новую тему.
Пробую такую запись, но не срабатывает.
[vba]
Код
Sub delete() For x = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 If Cells(x, 4).Value Like "<>*Вася*" Then Rows(x).Delete (xlShiftUp) Next x End Sub