Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Удаление всех строк, кроме указанных
 
Здравствуйте!

Ведётся база данных результатов в файле Excel. На текущий момент в нём примерно 40 листов и на каждом по 467 строк.
Еженедельно в этот файл добавляется по одной-две строке и затем производится удаление большинства имеющихся строк так, чтобы оставалась новая/новые строки и ещё эннное количество старых строк из базы (в сумме их должно быть не больше 18-22). Потом на основе каждого из листов формируется график.

На данный момент в теле макроса указываются строки и/или диапазон строк, которые необходимо удалить, и затем это макрос запускается. После его отработки на всех листах остаются только прописанные в макросе строки.
Можно ли сделать так, чтобы указывать не удаляемое, а наоборот - то, что нужно оставить? Так просто проще.

Сейчас макрос выглядит следующим образом:
Код
Sub Удаление_ненужного()
'
'
    Application.ScreenUpdating = False ' отключаем обновление экрана


' Удаляем ставшие ненужными строки

    Dim ws As Worksheet    'декларирование переменой
    For Each ws In Worksheets
        ws.Activate    ' активируем лист
    If ws.Name <> "source" Then ' исключаем из обработки страницу source
' В скобках в следующей строке в формате "х:х" или "х:y", а также "х:х, y:z" указываем номера строк, которые надо удалить
        Range("2:22,24:28,33:33,36:37,39:51,54:95,97:125,127:145,147:256,258:283,285:393,395:396,398:406,408:447").Select
    ActiveWindow.SmallScroll Down:=0
        Selection.Delete Shift:=xlUp
    Range("H2").Select
    End If
    Next
    
End Sub
Строки нужно выбирать каждый раз разные, как и их содержимое, а потому создать фильтры по содержимому ячеек просто нет смысла.

Заранее спасибо!.
 
Greg50, нужно ведь ещё как-то ограничить диапазон: ведь на листе более миллиона строк. Если укажем, например, не удалять строки 2:10, то представьте, сколько строк подлежит удалению.
 
Юрий М,
Ну это само собой, конечно (эту задачку я уже сам решу, поэтому не стал спрашивать). В принципе, можно от балды поставить вручную, например, диапазон до 600-й строки. Этого надолго хватит.
 
Скажите, а данные, которые нужно оставить, располагаются как? Подряд в строках некий блок, или среди строк надо оставлять, третью, восьмую и с одиннадцатой по двадцать пятую?
Кому решение нужно - тот пример и рисует.
 
Пытливый,
Второе: строки могут идти и подряд, и вразнобой. В примере так есть: пропускаются строки 23, 29, 30, 31, 32, 34, 35, 38, 52, 53, 96, 126 и т.д.
 
Подразумевается, что последняя указанная строка является последней в диапазоне и не удаляется
Код
Sub Del_Rows()
Dim ws As Worksheet
Dim rRng As Range, aSpl
Dim lMin As Long, lMax As Long, j As Long
Dim sStr As String: sStr = "2:5,8:9,12:15"
    aSpl = Split("0:0," & sStr, ":"): sStr = ""
    
    For j = 1 To UBound(aSpl) - 1
        lMin = 1 + Val(Split(aSpl(j), ",")(0))
        lMax = (Split(aSpl(j), ",")(1)) - 1
        
        If lMax >= lMin Then sStr = sStr & "," & lMin & ":" & lMax
    Next j
    
    If sStr = "" Then Exit Sub
    sStr = Mid$(sStr, 2)
    Application.ScreenUpdating = False
 
    For Each ws In Worksheets
        If ws.name <> "source" Then
            Set rRng = ws.Range(sStr): rRng.EntireRow.Rows.Delete
        End If
    Next ws
    
    Application.ScreenUpdating = True
    Set rRng = Nothing: MsgBox "Готово", 64, ""
End Sub
 
vikttur, спасибо!

А можно ещё упростить до номеров строк, а не интервалов? Иначе говоря, вида "номер строки,номер строки,номер строки" без символа двоеточия и повтора (даже если нужно оставить несколько подряд, то всё равно пишется каждая, например, 2,30,40,51,52,53,54,55,100,150)? Или это слишком сильно усложнит макрос?
Пока что пользуюсь документом лишь я сам (достался несколько лет назад "по наследству" от предшественника, тогда объём был меньше и всё вручную делалось, пока я сам не автоматизировал), но на всякий случай нужно предусмотреть вариант, что будет пользоваться кто-то ещё с меньшим уровнем подготовки (собственно поэтому занялся переделкой).
Изменено: Greg50 - 18 Мар 2018 18:25:08
 
Изменения только в верхнем блоке:
Код
  
 
 
 ...
Dim sStr As String: sStr = "2,30,40,51,52,53,54,55,100,150"
    aSpl = Split("0," & sStr, ","): sStr = ""
     
    For j = 0 To UBound(aSpl) - 1
        lMin = 1 + Val(aSpl(j))
        lMax = Val(aSpl(j + 1)) - 1
...
 
Вроде работает. Спасибо огромное!
Страницы: 1
Читают тему (гостей: 1)
Наверх