Страницы: 1
RSS
Удалить строки, указав в качестве критерия диапазон значений.
 
Еще раз здравствуйте. Нашел макрос который идеально мне подходит но не могу понять что нужно написать "Запрос параметра" в строке lCol = Val(InputBox(1, "Запрос параметра", 1))
Описание макроса: Макрос которым можно удалить строки, указав в качестве критерия диапазон значений. Т.е. указав на «Лист2″ в столбце А(начиная с первой строки) несколько значений — они все будут удалены.
Подскажите как должна выглядеть строка кода lCol = Val(InputBox(1, "Запрос параметра", 1))
Ниже макрос
Код
Sub Del_Array_SubStr()
 Dim sSubStr As String 'искомое слово или фраза
 Dim lCol As Long 'номер столбца с просматриваемыми значениями
 Dim lLastRow As Long, li As Long
 Dim avArr, lr As Long
 lCol = Val(InputBox(1, "Запрос параметра", 1))
 If lCol = 0 Then Exit Sub
 Application.ScreenUpdating = 0
 lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
 'Имя листа с диапазоном значений на удаление
 With Sheets("Лист2")  
 avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
 End With
 'удаляем
 For lr = 1 To UBound(avArr, 1)
 sSubStr = avArr(lr, 1)
 For li = lLastRow To 1 Step -1
 If CStr(Cells(li, lCol)) = sSubStr Then Rows(li).Delete
 Next li
 Next lr
 Application.ScreenUpdating = 1
End Sub
 
Это номер столбца, где ищется критерий.
 
в описании макроса по поводу этой строчки написано следующее :
Код
lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "Запрос параметра", 1))

я проставляю
Код
lCol = Val(InputBox(1, "Запрос параметра", 1))

если я правильно понял , а что написать вместо "Запрос параметра" - я не знаю
 
Разница чисто эстетическая :)
Проверьте код:

Код
Sub tt()
    lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "Запрос параметра", 1))
    MsgBox lCol
    lCol = Val(InputBox(1, "Запрос параметра", 1))
    MsgBox lCol
End Sub
 
Hugo, нечего не произошло , выскакивают окна но не удаляются значения
 
Уф... я лучше в танки поиграю....
 
я пробовал просто поставить
Код
lCol =1

но тогда он макрос не срабатывает и ссылается на строку
Код
For lr = 1 To UBound(avArr, 1)
 
Для того, как работает макрос из Вашего первого сообщения, я написал бы следущее описание:

Описание макроса: Макрос которым можно удалить строки, используя в качестве критерия диапазон значений. Т.е.
Макрос, на активном, листе сравнивает каждое значение в столбце, номер которого Вы укажете в Inputbox, со значениями столбца "А" на листе с именем "Лист2". При каждом совпадении, полностью удаляется строка активного листа, которая содержит совпавшее значение.

Насколько он идеально подходит - судить Вам,  та как нас в суть задачи не посвящали.
 
Печально , проверил действительно проверяет полное соответствие. Можете подсказать по этому макросу
тоже нашел у Вас на форуме думал мне подойдет, но он удаляет только первые два значения "Пункт обслуживания", "Всего по Агенту:" если находит, а все что я дальше указал через запятую нет как можно это поправить что бы он искал все значения ? и еще один нюанс у меня есть значения которые нужно удалять но они постоянно меняются я попробовал следующим образом с помощью этого макроса "Общее сальдо Клирингового Центра*"  - но он чет тоже не понимает что я от него хочу
Код
Sub Макрос1()
Dim iRange As Range
Dim TextToFindArray As Variant
Dim i As Long
TextToFindArray = Array("Пункт обслуживания", "Всего по Агенту:", "Валюта: UAH, Украинская гривна", "Всего по Валюте:", "Клиринговый центр: ПриватБанк (2)", "Всего по Клиринговому центру:", "Всего по Валюте:", "Валюта: RUR, Российские рубли", "Общее сальдо Клирингового Центра*" )
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
For i = 0 To 1
With ActiveSheet.Cells
Set iRange = .Find(What:=TextToFindArray(i), LookIn:=xlFormulas, LookAt:=xlPart)
If Not iRange Is Nothing Then
Do
iRange.EntireRow.Delete
Set iRange = .Find(What:=TextToFindArray(i), LookIn:=xlFormulas, LookAt:=xlPart)
Loop While Not iRange Is Nothing
End If
End With
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
Изменено: Marat_Mamedov - 24.07.2019 09:54:59
 
Вообще на сайте, с которого Вы взяли код сначала приведен как раз такой, который сравнивает по частичному совпадению строки. Затем по полному соответствию. Затем уже приведенный Вами здесь - по массиву критериев. Советую внимательнее прочитать статью: Как удалить строки по условию?
Вам надо всего-то лишь взять строку из первого кода и применить к последнему:
вместо:
Код
If CStr(Cells(li, lCol)) = sSubStr Then Rows(li).Delete

Код
If InStr(Cells(li, lCol), sSubStr) = lMet Then Rows(li).Delete
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, Поменял как Вы говорите но не получилось(
Прикрепил пример как я поправил
Изменено: Marat_Mamedov - 15.03.2013 12:54:44
 
перевыставил пример поменял код как было сказано , он вообще снес весь масив данных
 
применять тоже надо уметь:
Код
If InStr(Cells(li, lCol), sSubStr) <> lMet Then Rows(li).Delete

или
Код
If InStr(Cells(li, lCol), sSubStr) Then Rows(li).Delete

Итог:
Код
Sub Del_Array_SubStr()
    Dim sSubStr As String    'искомое слово или фраза
    Dim lCol As Long    'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim avArr, lr As Long

    lCol = 1
    If lCol = 0 Then Exit Sub
    Application.ScreenUpdating = 0
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    'Имя листа с диапазоном значений на удаление
    With Sheets("Лист2")
        avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    'удаляем
    For lr = 1 To UBound(avArr, 1)
        sSubStr = avArr(lr, 1)
        For li = lLastRow To 1 Step -1
            If InStr(Cells(li, lCol), sSubStr) Then Rows(li).Delete
        Next li
    Next lr
    Application.ScreenUpdating = 1
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, Спасибо Вам большое , я уже думал что это нереально реализовать . Еще раз огромное Вам спасибо
 
Помогите!
Немного усовершенствовал. Автоматический создается "Лист1", потом в него подтягиваются данные из указанного файла на рабочем столе (или другая ссылка), после чего происходит удаление по соответствию в активном листе строк, потом удаляется "Лист1", сохраняется и закрывается.
НО!!!! Мне нужно что бы не выходило уведомление и запрос с какого столбца брать данные, я хочу что бы данные брались всегда с первого столбца из "Лист1", как это можно исполнить?
Код
Sub Delete()
Sheets.Add.Name = "Лист1"
 Dim sh As Object
    Set sh = ActiveSheet
    With GetObject("D:\Desktop\вывод.xlsx")
        .Worksheets(1).Range("A1:A710").Copy sh.Cells(1, 1)
        .Close 0
    End With
    Sheets("Планограмма").Activate
     Dim sSubStr As String    'искомое слово или фраза
    Dim lCol As Long    'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim avArr, lr As Long
    Dim arr
 
    lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "Запрос параметра", 1))
    If lCol = 0 Then Exit Sub
    Application.ScreenUpdating = 0
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    'заносим в массив значения листа, в котором необходимо удалить строки
    arr = Cells(1, lCol).Resize(lLastRow).Value
    'Получаем с Лист2 значения, которые надо удалить в активном листе
    With Sheets("Лист1") 'Имя листа с диапазоном значений на удаление
        avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    'удаляем
    Dim rr As Range
    For lr = 1 To UBound(avArr, 1)
        sSubStr = avArr(lr, 1)
        For li = 1 To lLastRow 'цикл с первой строки до конца
            If CStr(arr(li, 1)) = sSubStr Then
                If rr Is Nothing Then
                    Set rr = Cells(li, 1)
                Else
                    Set rr = Union(rr, Cells(li, 1))
                End If
            End If
            DoEvents
        Next li
        DoEvents
    Next lr
    If Not rr Is Nothing Then rr.EntireRow.Delete
    Application.ScreenUpdating = 1
    Application.DisplayAlerts = False
   Sheets("Лист1").Delete
   Application.DisplayAlerts = True
   ActiveWorkbook.Save
   ActiveWorkbook.Close
   End Sub
 
Цитата
Re_ написал:
Немного усовершенствовал
точно сами это делали? Плохо верится, т.к. если смогли так усовершенствовать, то вряд ли для Вас было бы сложно проследить где задается номер столбца и тупо подставить там цифру. Достаточно вместо
Код
lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "Запрос параметра", 1))
записать
Код
lCol = 1
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
точно сами это делали?
Честно сам делал )))
Я самоучка, не совсем все понимаю в макросах
 
Цитата
Re_ написал:
где задается номер столбца и тупо подставить там цифру.
Спасибо! Очень выручили!
 
Код
Sub Удаляем_множ_вхождения()
    Dim sSubStr As String    'искомое слово или фраза
    Dim lCol As Long    
    Dim lLastRow As Long, li As Long
    Dim avArr, lr As Long
    Dim arr
    lCol = "1" 'номер столбца с просматриваемыми значениями
    If lCol = 0 Then Exit Sub
    Application.ScreenUpdating = 0
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    'заносим в массив значения листа, в котором необходимо удалить строки
    arr = Cells(1, lCol).Resize(lLastRow).Value
    'Получаем с Лист1 значения, которые надо удалить в активном листе
    With Sheets("Лист1") 'Имя листа с диапазоном значений на удаление
        avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    'удаляем
    Dim rr As Range
    For lr = 1 To UBound(avArr, 1)
        sSubStr = avArr(lr, 1)
        For li = 1 To lLastRow 'цикл с первой строки до конца
            If CStr(arr(li, 1)) = sSubStr Then
                If rr Is Nothing Then
                    Set rr = Cells(li, 1)
                Else
                    Set rr = Union(rr, Cells(li, 1))
                End If
            End If
            DoEvents
        Next li
        DoEvents
    Next lr
    If Not rr Is Nothing Then rr.EntireRow.Delete
    Application.ScreenUpdating = 1
End Sub

я тоже пользовался данным макросом для удаления лишних строк в таблице (и пользуюсь до сих пор)
но возникла потребность не удалять, а перемещать (не копировать, а именно перемещать желательно не оставляя пустых строк) данные строки на другой лист (лист2 например) как это возможно реализовать? удаление буквально 1 строчкой прописано. Или создавать отдельную тему?
Код
If Not rr Is Nothing Then rr.EntireRow.Delete
 
В первых строках выражу благодарность автору и участникам форума- огромная работа, очень сильная поддержка вашими вопросами и ответами, спасибо всем!
Задам вопрос по удалению строк и я. Здравствуйте.

Есть таблица выгружаемая из программы. В это таблице отчёты по разным отделам.
Структура таблицы содержит в себе объединённые ячейки. Признак (наименование) отдела стоит в конце строки и эта ячейка объединённая (две строки). Когда запускаю макрос он удаляет строки с данными о подразделении которое мне не интересно оставляя остальные.
Поле 1поле 2поле 3поле 4поле 50000 поле 6поле 7 БР 3
поле8поле9
поле 1поле 2поле 3поле 4поле 5 0000 поле 6поле 7 БР 2
поле 8поле 9Поле 10
поле 11поле 12 поле 13
Использую вот такой макрос:
Код
Sub Удаление_Бригада_1()

    With ActiveSheet.UsedRange

        Set cCurrent = Cells.Find(What:="Бригада 1", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False)

        If Not cCurrent Is Nothing Then
        Do
            rowNext = cCurrent.Offset(1, 0).Row
            ActiveSheet.Rows(CStr(cCurrent.Row) & ":" & CStr(rowNext - 1)).Delete
            Set cCurrent = .FindNext
        Loop While Not cCurrent Is Nothing
End If
    End With

End Sub

Всё работает нормально. Удаляет все строки целиком, захватывая нижние, относящиеся к записи. Т.е. для БР3 удалит две строки, для БР 2 удалит 3 строки.

Вопрос вот в чём: Есть таблица где искомое значение находится, например, в Поле 2. В этом случае удаляется только одна строка, так как в первом случае поле (ячейка) с "БР 3" , а так же ПОЛЕ 4 и поле 5 , 6, 7 объединены с нижними ячейками, а во втором случае этого объединения нет.

Вопрос: как обеспечить удаление по искомой фразе в ячейке "Поле 2", так что бы удалялись все строки соответствующей записи?

Что-то никак не пойму... В VBA самоучка в связи с обстоятельствами, прошу простить.
Изменено: Константин - - 10.06.2022 22:04:53
Страницы: 1
Наверх