Помогите!
Немного усовершенствовал. Автоматический создается "Лист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 |
