Суть проблемы в том, что если ввести искомое значение например - 1, то макрос удаляет и 100 и 111 и т.д., тоже самое происходит и с другими числами. Можно как-то дописать его, чтоб он удалял четко заданное значение? _______________________________________________________________________________________________________________________
Sub Del_SubStr() Dim sSubStr As String 'искомое слово или фраза(может быть указанием на ячейку) Dim lCol As Long 'номер столбца с просматриваемыми значениями Dim lLastRow As Long, li As Long Dim lMet As Long Dim arr
sSubStr = InputBox("Укажите КОД клиента для удаления", "Запрос параметра", "") If sSubStr = "" Then lMet = 0 Else lMet = 1 lCol = Val(InputBox("Оставьте число - 1 и подтвердите", "Запрос параметра", 1)) If lCol = 0 Then Exit Sub
lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count arr = Cells(1, lCol).Resize(lLastRow).Value Application.ScreenUpdating = 0 Dim rr As Range For li = 1 To lLastRow If -(InStr(arr(li, lCol), sSubStr) > 0) = lMet Then If rr Is Nothing Then Set rr = Cells(li, 1) Else Set rr = Union(rr, Cells(li, 1)) End If End If Next li If Not rr Is Nothing Then rr.EntireRow.Delete Application.ScreenUpdating = 1 End Sub
Суть проблемы в том, что если ввести искомое значение например - 1, то макрос удаляет и 100 и 111 и т.д., тоже самое происходит и с другими числами. Можно как-то дописать его, чтоб он удалял четко заданное значение? _______________________________________________________________________________________________________________________
Sub Del_SubStr() Dim sSubStr As String 'искомое слово или фраза(может быть указанием на ячейку) Dim lCol As Long 'номер столбца с просматриваемыми значениями Dim lLastRow As Long, li As Long Dim lMet As Long Dim arr
sSubStr = InputBox("Укажите КОД клиента для удаления", "Запрос параметра", "") If sSubStr = "" Then lMet = 0 Else lMet = 1 lCol = Val(InputBox("Оставьте число - 1 и подтвердите", "Запрос параметра", 1)) If lCol = 0 Then Exit Sub
lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count arr = Cells(1, lCol).Resize(lLastRow).Value Application.ScreenUpdating = 0 Dim rr As Range For li = 1 To lLastRow If -(InStr(arr(li, lCol), sSubStr) > 0) = lMet Then If rr Is Nothing Then Set rr = Cells(li, 1) Else Set rr = Union(rr, Cells(li, 1)) End If End If Next li If Not rr Is Nothing Then rr.EntireRow.Delete Application.ScreenUpdating = 1 End Subenchanter54
Сообщение отредактировал enchanter54 - Четверг, 17.03.2016, 03:48