Страницы: 1
RSS
Удалять строки с текстом, который не подходит условию.
 
Есть код который удаляет текст по условию из столбца А, но нужно чтобы удалялся весь текст который не подходит условию. Не знаю пробовал изменить, но не получается
Код
Dim ra As Range, delra As Range
Application.ScreenUpdating = False
Удалить = Array("Астрахань*", "Волгоград*", "Рязань_*", "Саранск_*", "Итого*")
For Each ra In ActiveSheet.UsedRange.Rows
For Each word In Удалить
If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then
If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
End If
Next word
Next
If Not delra Is Nothing Then delra.EntireRow.Delete
 
Вадим Озем. Такой код есть. Но не совсем понятно, что вы хотите удалить. Только текст  который есть в массиве " Удалить" или строки где есть ячейки с этим текстом. А также надо читать правила форума. Нет файла примера, где есть исходные данные и что Вы хотите получить в итоге
 
Я хочу чтобы все условия которые я ввел сохранились, а то что не подходит условию удалить
Удалить = Array("Астрахань*", "Волгоград*", "Рязань_*", "Саранск_*", "Итого*") строки с таким текстом оставить, а все остальное удалить
Изменено: Вадим Озем - 22.11.2021 08:35:22
 
Покажите это в файле с примером
 
Примерно вот так
Изменено: Вадим Озем - 22.11.2021 08:45:07
 
Нужно удалить строки где в названиях отсутствует "_" (нижнее подчеркивание) или есть какой-то определенный список
Изменено: Msi2102 - 22.11.2021 08:48:09
 
В принципе такое условие подойдет, только тогда нужно еще шапку оставить и итоги  

оставить= Array("Астрахань*", "Волгоград*", "Рязань_*", "Саранск_*", "Итого*")
Получается все что в массиве нужно оставить а все остальное удалить
 
Вадим Озем, а могли бы сразу в вашем первом сообщении приложить файл с примером и в нем показать что есть и готовый результат, и словами подробно описать, чтобы мы поняли, но... Вы всё растянули на 10 сообщений... И вместо этого ещё написали ненужный нам макрос, который всех запутал. Нам не нужны никогда от вас никакие макросы. Нужен толковый пример в файле и нормальное описание словами
Изменено: New - 22.11.2021 09:13:54
 
доработаете под нужды
Код
Sub del()
Application.ScreenUpdating = False
strArrCond = Array("<>Астрахань*", "<>Волгоград*", "<>Рязань_*", "<>Саранск_*", "<>Итого*")
For i = 0 To UBound(strArrCond)
Cells(2, i + 5) = strArrCond(i)
Next
Range("e1:i1") = "Исходные данные"
Range("A1:B19").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("E1:I2"), Unique:=False
Rows("2:19").Delete Shift:=xlUp
ActiveSheet.ShowAllData
Range("e1:i2").ClearContents
Application.ScreenUpdating = True
End Sub
По вопросам из тем форума, личку не читаю.
 
Или так
Код
Sub Удаление_строк()
Dim r As Range, rng As Range, lr As Long
lr = Cells(Rows.Count, 2).End(xlUp).Row
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Pattern = "Астрахань|Волгоград|Рязань|Саранск|Итог"
For Each r In Range("A2:A" & lr)
    If Not objRegExp.Test(r) Then
        If rng Is Nothing Then Set rng = Rows(r.Row) Else Set rng = Union(rng, Rows(r.Row))
    End If
Next r
If Not rng Is Nothing Then rng.Delete
End Sub
Изменено: Msi2102 - 22.11.2021 09:27:50
 
Power Query
Код
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Исходные данные", type text}, {"Количество", Int64.Type}}),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Changed Type","Исходные данные",Splitter.SplitTextByDelimiter("_", QuoteStyle.Csv),{"Исходные данные.1", "Исходные данные.2"}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Исходные данные.1", type text}, {"Исходные данные.2", type text}}),
    #"Filtered Rows" = Table.SelectRows(#"Changed Type1", each ([Исходные данные.2] <> null)),
    #"Added Custom" = Table.AddColumn(#"Filtered Rows", "Custom", each [Исходные данные.1]&" "&[Исходные данные.2]),
    #"Removed Columns" = Table.RemoveColumns(#"Added Custom",{"Исходные данные.1", "Исходные данные.2"}),
    #"Reordered Columns" = Table.ReorderColumns(#"Removed Columns",{"Custom", "Количество"}),
    #"Renamed Columns" = Table.RenameColumns(#"Reordered Columns",{{"Custom", "исходные данные"}})
in
    #"Renamed Columns"
 
Всем Большое спасибо за помощь
 
jakim, а зачем такой сложный код, если если то, что вы делаете, достаточно:
Код
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Filtered Rows" = Table.SelectRows(Source, each Text.Contains([Исходные данные], "_"))
in
    #"Filtered Rows"
 
Спасибо за подсказку, т.к. я только  "тупарь-самоучка".
 
вариант на pq:
Код
let
    a = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    b = {"Астрахань", "Волгоград", "Рязань", "Саранск", "Итог"},
    c = Table.SelectRows(Table.TransformColumns(a, {"Исходные данные", (w)=> if Text.Contains(List.Accumulate(b, w, (x, y) => Text.Replace(x, y, "Q") ), "Q") = true then w else null}), each [Исходные данные] <> null)
in
    c
 
Самый крутой вариант решения у БМВ.  Я сначала хотел с автофильтром написать, но с расширенным конечно проще получилось. У автора используется метод Find, но зачем организовывать цикл по строкам и Find. Вариант с методом Find.
Код
Sub Poisk()
Dim Rg1 As Range, Rg2 As Range, Rg3 As Range, Adres$, arr1, Tp1, i&
arr1 = Array("Исходные данные", "Астрахань", "Волгоград", "Рязань", "Саранск", "Итог")
Set Rg1 = Cells(1).CurrentRegion.Columns(1)
For Each Tp1 In arr1
    Set Rg2 = Rg1.Cells.Find(arr1(i), , xlValues, xlPart)
If Not Rg2 Is Nothing Then
    Adres = Rg2.Address
    If Rg3 Is Nothing Then Set Rg3 = Rg2 Else Set Rg3 = Union(Rg3, Rg2)
        Do
Set Rg3 = Union(Rg3, Rg2): Set Rg2 = Rg1.Cells.FindNext(After:=Rg2)
        Loop Until Rg2.Address = Adres
End If: i = i + 1: Next
Rg3.EntireRow.Hidden = True: Set Rg2 = Rg1.Cells.SpecialCells(xlCellTypeVisible)
Rows.Hidden = False: Rg2.EntireRow.Delete
End Sub
Изменено: Евгений Смирнов - 23.11.2021 06:03:46
Страницы: 1
Наверх