Excel Удалить строки между двумя конкретными ячейками - PullRequest
Новая
       28

Excel Удалить строки между двумя конкретными ячейками

0 голосов
/ 03 февраля 2019

Я хочу удалить все строки между двумя ячейками, содержащими определенный текст.

Например: ячейка B16 содержит Description, а ячейка B28 содержит Transportation.Я хочу удалить все строки между строками ячеек, содержащих Description и Transportation.Мне нужно решение VBA, чтобы решить эту проблему.

Большое спасибо заранее.Punith

Ответы [ 2 ]

0 голосов
/ 03 февраля 2019

вы можете написать вспомогательную функцию, которая принимает диапазон для сканирования, текст для поиска и найденный диапазон в качестве параметров и возвращает True, если найденный диапазон действительно найден: 

Function GetCellWithText(rngToScan As Range, txtToSearch As String, foundRng As Range) As Boolean
    With rngToScan
        Set foundRng = .Find(what:=txtToSearch, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, after:=.Cells(.Count))
    End With
    GetCellWithText = Not foundRng Is Nothing
End Function

и использоватьв основном коде он выглядит следующим образом: 

Option Explicit

Sub DeleteRowsBetweenCellsWithSpecificTexts()
    Dim txt1Rng As Range, txt2Rng As Range

    With Range("B1", Cells(Rows.Count, 2).End(xlUp)) ' reference currently active sheet column B range from row 1 down to last not empty one
        If Not GetCellWithText(.Cells, "Description", txt1Rng) Then Exit Sub ' if first text not found do nothing
        If Not GetCellWithText(.Cells, "Transportation", txt1Rng) Then Exit Sub ' if second text not found do nothing

        If txt2Rng.Row = txt1Rng.Row + 1 Then Exit Sub ' if found cells are adjacent then do nothing
    End With

    Range(txt1Rng.Offset(1), txt2Rng.Offset(-1)).Delete
End Sub

этот код действует на текущем активном листе

, если вам нужно запустить его на определенном листе, тогда просто укажите правильные спецификации листа перед вызовами Range(т.е. Worksheets("MySheetName").Range(...))

0 голосов
/ 03 февраля 2019

Удалить строки между критериями

  • Измените значения в разделе константы в соответствии со своими потребностями.
  • Сначала проверьте код с помощью Hide (Const cDel As Boolean = False).Если вы уверены, что он выполняет то, что вам нужно, измените cDel на True, чтобы удалить Критические строки (Const cDel As Boolean = True).
  • Строки, содержащие Критерии (Описание, Транспорт) не будет удалено (скрыто).
  • Если Критерии не найдены, код ничего не сделает.

Код 

Sub HideDeleteDT()

    Const cSheet As Variant = "Sheet1"        ' Source Worksheet Name/Index
    Const cStr1 As String = "Description"     ' Criteria 1
    Const cStr2 As String = "Transportation"  ' Criteria 2
    Const cCol As Variant = "B"               ' Criteria Column Letter/Number
    Const cDel As Boolean = False             ' Enable Delete(True), Hide(False)

    Dim Find1 As Range  ' Criteria 1 Cell Range
    Dim Find2 As Range  ' Criteria 2 Cell Range
    Dim LCell As Range  ' Last Cell in Criteria Column

    ' In Source Worksheet
    With ThisWorkbook.Worksheets(cSheet)
        ' In Criteria Column
        With .Columns(cCol)
            ' Assign last cell range in Criteria Column to variable.
            Set LCell = .Cells(.Cells.Count)
            ' Find Criteria 1 and assign the found cell range to variable.
            Set Find1 = .Find(cStr1, LCell, xlValues, xlWhole, xlByColumns)
        End With
        ' Check if Criteria 1 was found.
        If Not Find1 Is Nothing Then
            ' Find Criteria 2 and assign the found cell range to variable.
            Set Find2 = .Range(Find1.Offset(1), LCell).Find(cStr2, LCell)
            ' Check if Criteria 2 was found.
            If Not Find2 Is Nothing Then
                ' To prevent hiding or deleting rows of the Criteria Cell Ranges
                ' after Critical Rows have already been deleted (Delete) or(and)
                ' the Criterias are in concecutive rows (Hide).
                If Find1.Row + 1 < Find2.Row Then
                    ' Hide or delete rows between found Criteria Cell Ranges.
                    If cDel Then ' Delete (Unsafe). You will lose data.
                        .Rows(Find1.Row + 1 & ":" & Find2.Row - 1).Delete
                      Else       ' Hide (Safe). No loss of data.
                        ' Show all rows to visualize what exactly is being
                        ' hidden by the code each time i.e. if rows have
                        ' previously been hidden it would be unclear which ones
                        ' have been hidden each ('this') time.
                        .Rows.Hidden = False
                        .Rows(Find1.Row + 1 & ":" & Find2.Row - 1).Hidden = True
                    End If
                End If
            End If
        End If
    End With

End Sub

Поиск метода Примечания

  • 1-й аргумент What содержит данные для поиска и обязателен .Все остальные аргументы являются необязательными.
  • 2-й аргумент, После , устанавливается на Последнюю ячейку, после которой он начинает поиск с первой (верхней (левой)) ячейки в столбце.(диапазон), обозначенный пропущенными по умолчанию SearchDirection параметр xlNext.
  • 3-й, 4-й и 5-й аргументы, LookIn , LookAt и SearchOrder сохраняются каждый раз и поэтому могут быть опущены при втором поиске (Set Find2 = ...).
    • LookIn установлен на xlValues для предотвращения поиска в формулах (или комментариях).
    • LookAt установлен на xlWhole для предотвращенияпоиск частей параметра What в ячейках, например, Type Description, не будет найден.
    • SearchOrder может быть безопасно пропущен, так как мы ищем в одномдиапазон колонн.
  • Шестой аргумент SearchDirection по по умолчанию xlNext используется в коде и поэтому может быть безопасно пропущен.
  • Седьмой аргумент MatchCase по по умолчанию False, который не рассматривается в вопросе ОП и поэтому опущен.
...