Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Удаление cтрок по условию, "Запрос параметра" - не знаю что нужно написать
 
Еще раз здравствуйте. Нашел макрос который идеально мне подходит но не могу понять что нужно написать "Запрос параметра" в строке 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
Изменено: Marat_Mamedov - 15 Мар 2013 00:58:38
 
Это номер столбца, где ищется критерий.
 
в описании макроса по поводу этой строчки написано следующее :
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 - 15 Мар 2013 09:47:27
 
Вообще на сайте, с которого Вы взяли код сначала приведен как раз такой, который сравнивает по частичному совпадению строки. Затем по полному соответствию. Затем уже приведенный Вами здесь - по массиву критериев. Советую внимательнее прочитать статью: Как удалить строки по условию?
Вам надо всего-то лишь взять строку из первого кода и применить к последнему:
вместо:
Код
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 Мар 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)
Наверх