Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.12.2010, 16:57   #11
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

а все равно надо будет "скучным" циклом по всему пройтись (см. Do ... Loop) с помощью Union собрать в один диапазон
а потом уже весело одной командой удалить.

вот скучный цикл делает то что написано в названии.
Код:
Sub Del_3_From_B()
  On Error Resume Next
  Columns("B").Find(what:=3, LookAt:=xlWhole).EntireRow.Delete
  Do
    Columns("B").FindNext.EntireRow.Delete
  Loop Until Err.Number > 0
  Err.Clear: On Error GoTo 0
End Sub
если еще в начале запретить обновление экрана, автоматический пересчет, а в конце процедуры разрешить это все, то
затрудняюсь сказать вообще вы уловите разницу в продолжительности работы этих процедур при удалении 1000 строк, не говоря о 10-20 штуках.
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 11.12.2010, 12:57   #12
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Цитата:
есть таблица 10 столбцов и дофига строк(2000-3000),
ну так вот из нее нужно удалить
строки в которых хотя-бы одна из десяти ячеек пустая
Цитата:
задача такая - надо удалить несколько строк. Циклом - скучно...
Согласен. Чтобы не скучать, можно без цикла:
Код:
Sub DelRows()
    On Error Resume Next
    Intersect(ActiveSheet.UsedRange, [A1:J2000].SpecialCells(xlCellTypeBlanks).EntireRow).Delete
End Sub
Здесь [A1:J2000] - это контролируемый диапазон. А On Error Resume Next - это на случай, если в этом диапазоне нет ни одной пустой ячейки.


P.S. Забыл пояснить, что если в одной строке диапазона найдется несколько пустых ячеек, то использовать ...SpecialCells(xlCellTypeBlanks).E ntireRow.Delete не получится, т.к. данная команда неприменима к пересекающимся диапазонам. Именно поэтому в коде применено получение нового "чистого" диапазона с помощью Intersect...
Чем шире угол зрения, тем он тупее.

Последний раз редактировалось SAS888; 11.12.2010 в 13:04. Причина: Добавлено
SAS888 вне форума Ответить с цитированием
Старый 11.12.2010, 21:58   #13
leech
 
Регистрация: 25.11.2010
Сообщений: 7
По умолчанию

Я вобщето про случай проще спрашивал. Так что все таки понял как можно без циклов
Просто удалить несколько строк "от меня и до следующего дуба". Без всяких дополнительных условий, только как в Rows("1:200").Delete вместо явного указания 1-й и последней строки поставить переменные? До сегодня использовал For... Next и удалял по 1 строке...
Вот осенило наконец. Может кому еще поможет совсем начинающему. Пример удаления 200 строк без цикла:

Sub nRowDelete()
Dim DelRows As String
Dim RowFirst As Integer, RowEnd As Integer

RowFirst = 1 'первая строка для удаления
RowLast = 200 'последняя строка
DelRows = RowFirst & ":" & RowLast
Rows(DelRows).Delete
End Sub
leech вне форума Ответить с цитированием
Старый 25.01.2011, 22:17   #14
S63AMG
 
Регистрация: 25.01.2011
Сообщений: 4
По умолчанию

Здравствуйте!
Пожалуйста помогите сделать макрос для "производственных задач"
Дано: массив - 6 столбцов, около 1000 строк.
Задача макроса: удалять строки, в которых есть только одна пустая ячейка (она всегда находится в 5 столбце).
Если же в строке больше чем 1 пустая ячейка (например 2 рядом) - оставлять строку нетронутой.

Благодарю за помощь.
S63AMG вне форума Ответить с цитированием
Старый 25.01.2011, 22:34   #15
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

Код:
Sub DelBlank()
  For r = UsedRange.Rows.Count + UsedRange.Row - 1 To UsedRange.Row Step -1
    If Cells(r, 5) = "" Then
      n = 0
      For c = 1 To 6: If Cells(r, c) = "" Then n = n + 1: Next
      If n = 1 Then Rows(r).Delete
    End If
  Next
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 26.01.2011, 06:03   #16
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Видимо, уважаемый IgorGO очень куда-то спешил.
1. При обращении к используемому диапазону рабочего листа, лист нужно указывать обязательно. Т.е. не просто UsedRange, а, например, ActiveSheet.UsedRange. Иначе будет ошибка.
2. Разделять операторы, записывая их в одну строку, знаком ":" можно, но не всегда. Так, например, нельзя использовать в одной строке For и If:
For c = 1 To 6: If Cells(r, c) = "" Then n = n + 1: Next - будет ошибка.
3. При последовательном удалении строк, целесообразно запрещать изменение экрана: Application.ScreenUpdating = False

Предлагаю другой вариант, в котором перебираются не все строки листа, а только те, в 5-м столбце (столбце "E") которых пусто. Причем, ячейки в этих строках вообще не перебираются (что существенно быстрее). Затем контролируем, есть ли еще пустые ячейки в таблице. И, если нет, то формируем диапазон строк листа для последующего удаления. Удаление всех полученных строк осуществляется с помощью 1-й команды. Поэтому, это, во-первых, существенно быстрее, во-вторых, запрещать изменение экрана ни к чему.
Код:
Sub DelBlank2()
    Dim x As Range, y As Range
    For Each x In Intersect(ActiveSheet.UsedRange, [E:E].SpecialCells(xlCellTypeBlanks).EntireRow).Rows
        If Application.CountA(x) = ActiveSheet.UsedRange.Columns.Count - 1 Then _
        If y Is Nothing Then Set y = x Else Set y = Union(y, x)
    Next
    If Not y Is Nothing Then y.EntireRow.Delete
End Sub
Чем шире угол зрения, тем он тупее.

Последний раз редактировалось SAS888; 26.01.2011 в 06:18.
SAS888 вне форума Ответить с цитированием
Старый 26.01.2011, 08:26   #17
S63AMG
 
Регистрация: 25.01.2011
Сообщений: 4
По умолчанию Благодарность

Спасибо большое SAS888 и IgorGO за столь оперативную помощь! Воспользовался в итоге кодом SAS888. Очень помогло автоматизировать нудные операции
Однако еще очень важный вопрос: возможно ли этот макрос модифицировать, чтобы он удалял строки с ячейками, в которой содержится только один тег <br> и далее пустота?
Например в прикрепленной базе это строки с пустыми ячейками №58-61 и также строки №89-91.
Заранее спасибо за помощь
Вложения
Тип файла: zip Пример базы.zip (11.1 Кб, 14 просмотров)

Последний раз редактировалось S63AMG; 26.01.2011 в 23:22.
S63AMG вне форума Ответить с цитированием
Старый 27.01.2011, 08:54   #18
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

S63AMG, на сколько я понял, в 4-м столбце пустые значения и "0" считается равнозначным. Тогда можно так:
Код:
Sub Main()
    Application.ScreenUpdating = False: Rows(1).AutoFilter
    ActiveSheet.[A:A].AutoFilter Field:=5, Criteria1:="=<br>", Operator:=xlOr, Criteria2:="="
    ActiveSheet.[A:A].AutoFilter Field:=4, Criteria1:="<>0"
    Intersect(ActiveSheet.UsedRange, Rows("3:" & Rows.Count)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Rows(1).AutoFilter: Application.ScreenUpdating = True
End Sub
Пример во вложении. Запустите макрос "Main".
Вложения
Тип файла: rar Пример базы_2.rar (32.6 Кб, 22 просмотров)
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 27.01.2011, 12:19   #19
S63AMG
 
Регистрация: 25.01.2011
Сообщений: 4
По умолчанию

Хм, нет, уважаемый SAS888. Пустые значения и нули в 4 столбце вовсе не равнозначны Привязки содержимого ячейки (с одним тегом) из 5 столбца к содержимому соседней ячейки нет никакой. т.е. смело можно удалять строки в которых соседствуют ячейки с тегом и ячейки 4-го столбца с любыми числами от 0 до R.
Вот есть такое решение, работает верно:
Код:
Sub Макрос1()
On Error Resume Next
Application.ScreenUpdating = 0
r_ = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1").CurrentRegion.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="<>"
    Selection.AutoFilter Field:=2, Criteria1:="<>"
    Selection.AutoFilter Field:=3, Criteria1:="<>"
    Selection.AutoFilter Field:=4, Criteria1:="<>"
    Selection.AutoFilter Field:=6, Criteria1:="<>"
Selection.AutoFilter Field:=5, Criteria1:="=", Operator:=xlOr, Criteria2:="=<br>"
    Range("A2:A" & r_).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Selection.AutoFilter
Application.ScreenUpdating = 1
On Error GoTo 0
End Sub

Последний раз редактировалось S63AMG; 27.01.2011 в 12:21.
S63AMG вне форума Ответить с цитированием
Старый 27.01.2011, 12:58   #20
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Ну, значит я Вас не верно понял.
По поводу Вашего макроса: я бы не стал использовать CurrentRegion, т.к. если, например, в середине таблицы встретится пустая строка, то макрос отработает не верно. Надежнее заменить
Код:
Range("A1").CurrentRegion.AutoFilter
на
Код:
[A:F].AutoFilter
и в дальнейшем коде использовать не Selection, а [A:F]
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Macros для нахождения и удаления слов конгер Microsoft Office Word 1 13.10.2009 18:14
скрипт для удаления Cookies mahnograd Софт 10 18.09.2009 08:53
отмена удаления строки: вопрос Evgenii БД в Delphi 1 19.06.2009 01:43
Программа для удаления AutoRun вирусов pomoshnic Помощь студентам 1 01.04.2009 04:57
Нужна программа для удаления содержимого папки DNK1980 Фриланс 6 11.02.2008 16:52