Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1 2 След.
RSS
[ Закрыто ] Удаление всех строк в таблице с пустой ячейкой [ТЕМА ЗАКРЫТА - повторное нарушение]
 
#1
27.12.2011 11:19:16
Приветствую Вас.  
Я хочу с помощью макроса удалить все строки в таблице с одной или несколькими пустыми ячейками.  
Подскажите пожалуйста, как это сделать.  
Пример таблицы приведён в приклеплённом файле.  
Заранее благодарю Вас за помощь.
 
 
 
#2
27.12.2011 11:24:59
Поиском пользовались?  
Нет? А зря. Даже я смог найти такой готовый макрос.
 
 
 
#3
27.12.2011 11:25:03
А почему не в поиск? "Удаление строк с пустой ячейкой"
Я сам - дурнее всякого примера! ...
 
 
 
#4
27.12.2011 11:36:14
я только начинаю изучать макросы, может сможете мне подкинуть готовый вариант макроса для моего примера.
 
 
 
#5
27.12.2011 11:41:57
{quote}{login=Benson}{date=27.12.2011 11:36}{thema=Re: }{post}я только начинаю изучать макросы, может сможете мне подкинуть готовый вариант макроса для моего примера.{/post}{/quote}В поиск забейте название темы.
 
 
 
#6
27.12.2011 11:51:26
на сайте http://www.excel-vba.ru/ есть хороший макрос удаления строк по условию
 
 
 
#7
27.12.2011 22:55:46
При удалении строк таблицы excel при помощи vba:  
 
При записи макроса пишет код:  
Range("Расходы_товары").Select  
Selection.ListObject.ListRows(1).De lete  
Selection.ListObject.ListRows(1).De lete  
Selection.ListObject.ListRows(1).De lete  
Selection.ListObject.ListRows(1).De lete  
Selection.ListObject.ListRows(1).De lete  
Selection.ListObject.ListRows(1).De lete  
Selection.ListObject.ListRows(1).De lete  
Selection.ListObject.ListRows(1).De lete  
Selection.ListObject.ListRows(1).De lete  
Selection.ListObject.ListRows(1).De lete  
Selection.ListObject.ListRows(1).De lete  
Selection.ListObject.ListRows(1).De lete  
Selection.ListObject.ListRows(1).De lete  
Selection.ListObject.ListRows(1).De lete  
 
А код написанный мной для таблицы содержащей разное количество строк не работает.  
 
Range("Расходы_товары").Select  
Selection.ListObject.ListRows.De lete
 
 
 
#8
27.12.2011 23:03:42
Использовал макрос умных людей:  
 
Option Explicit  
 
Sub УдалениеСтрокПоУсловию()  
   Dim ra As Range, delra As Range, ТекстДляПоиска As String  
   Application.ScreenUpdating = False    ' отключаем обновление экрана  
  'ТекстДляПоиска = InputBox("Введите криерий для удаления строк")    ' удаляем строки с таким текстом  
   ТекстДляПоиска = ""  ' удаляем пучтые строки  
   ' перебираем все строки в используемом диапазоне листа  
  For Each ra In ActiveSheet.UsedRange.Rows  
       ' если в строке найден искомый текст  
      If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then  
           ' добавляем строку в диапазон для удаления  
          If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)  
       End If  
   Next  
   ' если подходящие строки найдены - удаляем их  
  If Not delra Is Nothing Then delra.EntireRow.Delete  
End Sub  
 
 
Он мне стёр все таблицы, и даже те которые удалять не надо было.
 
 
 
#9
27.12.2011 23:50:22
Вот макрос для Вашего примера:  
Sub www()  
On Error Resume Next  
   [D:D].Replace 0, "", LookAt:=xlWhole
   [a1].CurrentRegion.SpecialCells(4).EntireRow.Delete
End Sub
Я сам - дурнее всякого примера! ...
 
 
 
#10
28.12.2011 06:25:14
{quote}{login=KukLP}{date=27.12.2011 11:50}{thema=}{post}Вот макрос для Вашего примера:  
Sub www()  
On Error Resume Next  
   [D:D].Replace 0, "", LookAt:=xlWhole
   [a1].CurrentRegion.SpecialCells(4).EntireRow.Delete
End Sub{/post}{/quote}  
 
А как заставить макрос работать с этой таблицей?  
Спасибо.
 
 
 
#11
28.12.2011 06:39:46
попаразитировать на макросе Сергея:  
Sub www1()  
On Error Resume Next  
[a1].CurrentRegion.SpecialCells(4).EntireRow.Delete
End Sub
 
 
 
#12
28.12.2011 06:47:41
Попытался использовать    
   Range("Таблица2").Select
 
 
 
#13
28.12.2011 07:15:39
Попробовал прописать так:  
 
Dim i As Integer  
i = ActiveCell.Row - Range("Таблица2").Row + 1  
Range("Таблица2").ListObject.ListRows(i).Delete  
 
По прежнему не работает.
 
 
 
#14
28.12.2011 07:17:27
{quote}{login=Станислав}{date=28.12.2011 07:15}{thema=}{post}Попробовал прописать так:  
 
Dim i As Integer  
i = ActiveCell.Row - Range("Таблица2").Row + 1  
Range("Таблица2").ListObject.ListRows(i).Delete  
 
По прежнему не работает.{/post}{/quote}  
 
Dim i As Integer  
 
i = Range("Расходы_товары").Row  
Range("Расходы_товары").ListObject.ListRows(i).Delete  
 
Такой вариант тоже не проходит
 
 
 
#15
28.12.2011 09:24:14
А так?  
Sub www()  
Dim aaa&  
On Error Resume Next  
   [D:D].Replace 0, "", LookAt:=xlWhole
   For i = [a1].CurrentRegion.Rows.Count To 2 Step -1
   aaa = 0  
   aaa = Rows(i).SpecialCells(4).Count  
   If aaa > 0 Then Rows(i).Delete  
   Next  
End Sub  
 
PS Плз, объясните знающие люди, а почему эта процедура без переменной не работает?  
Т.е. если не поставить обнуление, при отсутствии пустых ячеек обнуления  не происходит.
 
 
 
#16
28.12.2011 09:32:50
Понял, спасибо. Про ошибку не подумал.
 
 
 
#17
28.12.2011 09:52:52
{quote}{login=KukLP}{date=27.12.2011 11:50}{thema=}{post}Вот макрос для Вашего примера:  
Sub www()  
On Error Resume Next  
   [D:D].Replace 0, "", LookAt:=xlWhole
   [a1].CurrentRegion.SpecialCells(4).EntireRow.Delete
End Sub{/post}{/quote}  
 
 
ОГРОМНОЕ ВАМ СПАСИБО!!!!  
ПРОСТО КЛАСС....  
РАБОТАЕТ НА ВСЕ 100%....
 
 
 
#18
28.12.2011 09:54:43
{quote}{login=}{date=28.12.2011 09:52}{thema=Re: }{post}{quote}{login=KukLP}{date=27.12.2011 11:50}{thema=}{post}Вот макрос для Вашего примера:  
Sub www()  
On Error Resume Next  
   [D:D].Replace 0, "", LookAt:=xlWhole
   [a1].CurrentRegion.SpecialCells(4).EntireRow.Delete
End Sub{/post}{/quote}  
 
 
ОГРОМНОЕ ВАМ СПАСИБО!!!!  
ПРОСТО КЛАСС....  
РАБОТАЕТ НА ВСЕ 100%....
 
 
 
#19
28.12.2011 09:55:58
{quote}{login=KukLP}{date=27.12.2011 11:50}{thema=}{post}Вот макрос для Вашего примера:  
Sub www()  
On Error Resume Next  
   [D:D].Replace 0, "", LookAt:=xlWhole
   [a1].CurrentRegion.SpecialCells(4).EntireRow.Delete
End Sub{/post}{/quote}  
 
 
ОГРОМНОЕ ВАМ СПАСИБО!!!!  
ПРОСТО КЛАСС....  
РАБОТАЕТ НА ВСЕ 100%....
 
 
 
#20
28.12.2011 10:00:05
Че-то Bensonа заело:-)
Я сам - дурнее всякого примера! ...
 
 
 
#21
28.12.2011 10:17:36
Да уж...Бывает и такое...Комп завис :)  
Щас проверил Ваш макрос для таблицы с другим расскладом, но что-то не работает :(
 
 
 
#22
28.12.2011 11:41:44
Насчет "другим расскладом, но что-то не работает". В правилах форума: "Совсем необязательно выкладывать файл полностью. Зачастую, чтобы понять и помочь - достаточно таблицы на 10-20 строк. Но при этом старайтесь сохранить структуру, расположение таблиц, имена листов - аналогично оригиналу. Если файл содержит служебную информацию - просто замените Ваши данные на нейтральные. На сайте любят оперировать с апельсинами :-)" Отправил Ваш файл по почте.
Я сам - дурнее всякого примера! ...
 
 
 
#23
28.12.2011 11:50:51
Ещё раз хочу поблагодарить Вас за помощь...  
Вы мне очень помогли...  
Вот мне бы так уметь писать макросы, в этом деле я только начинающий :)...
 
 
 
#24
28.12.2011 14:38:34
{quote}{login=Станислав}{date=28.12.2011 07:17}{thema=Re: }{post}{quote}{login=Станислав}{date=28.12.2011 07:15}{thema=}{post}Попробовал прописать так:  
 
Dim i As Integer  
i = ActiveCell.Row - Range("Таблица2").Row + 1  
Range("Таблица2").ListObject.ListRows(i).Delete  
 
По прежнему не работает.{/post}{/quote}  
 
Dim i As Integer  
 
i = Range("Расходы_товары").Row  
Range("Расходы_товары").ListObject.ListRows(i).Delete  
 
Такой вариант тоже не проходит{/post}{/quote}  
 
 
 
Попробуй так, может получится:  
Sub DelRow()  
   With ListObjects("Таблица2")  
       .ListRows(.ListRows.Count).Delete  
   End With  
End Sub  
А если нет, тогда я тоже не знаю.... )))
 
 
 
#25
28.12.2011 16:20:25
Sub www()  
   Dim i&, a As Range: On Error Resume Next  
   With ActiveSheet.ListObjects("Таблица2")  
       For i = 1 To 4  
           .Range.AutoFilter i, "=0", 2, "="  
           For Each a In .DataBodyRange.SpecialCells(12).Areas  
               a.EntireRow.Delete  
           Next  
           .Range.AutoFilter Field:=i  
       Next  
   End With  
End Sub
Я сам - дурнее всякого примера! ...
 
 
 
#26
28.12.2011 16:24:25
Для 0:  
           .Range.AutoFilter i, "=0.00", 2, "="
Я сам - дурнее всякого примера! ...
 
 
 
#27
28.12.2011 21:52:26
{quote}{login=KukLP}{date=28.12.2011 04:24}{thema=}{post}Для 0:  
           .Range.AutoFilter i, "=0.00", 2, "="{/post}{/quote}  
Спасибо. Попробую.
 
 
 
#28
28.12.2011 23:15:32
{quote}{login=KukLP}{date=28.12.2011 04:20}{thema=}{post}Sub www()  
   Dim i&, a As Range: On Error Resume Next  
   With ActiveSheet.ListObjects("Таблица2")  
       For i = 1 To 4  
           .Range.AutoFilter i, "=0", 2, "="  
           For Each a In .DataBodyRange.SpecialCells(12).Areas  
               a.EntireRow.Delete  
           Next  
           .Range.AutoFilter Field:=i  
       Next  
   End With  
End Sub{/post}{/quote}  
 
SpecialCells(12).Areas, при увеличении таблица цифру 12 менять  
Range.AutoFilter i, "=0", 2, "=", а это разбивка по столбцам?
 
 
 
#29
28.12.2011 23:31:43
1) >>SpecialCells(12).Areas, при увеличении таблица цифру 12 менять  
Ни в коем случае. SpecialCells(12) - это только видимые(отобранные) ячейки.  
2) Да.
Я сам - дурнее всякого примера! ...
 
 
 
#30
28.12.2011 23:56:42
{quote}{login=KukLP}{date=27.12.2011 11:50}{thema=}{post}Вот макрос для Вашего примера:  
Sub www()  
On Error Resume Next  
   [D:D].Replace 0, "", LookAt:=xlWhole
   [a1].CurrentRegion.SpecialCells(4).EntireRow.Delete
End Sub{/post}{/quote}  
Ребята извините за непрошеное вторжение в тему, но вот никак не пойму, что в макросе поменять, чтобы он удалял строку, по пустым ячейкам, только одного, конкретно взятого столбца?  
С ув. Муля!
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх