Sub Delete_with_Autofilter_More_Criteria()
Dim rng As Range
Dim cell As Range
Dim CriteriaRng As Range
Dim calcmode As Long
With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With Sheets("Sheet2")
Set CriteriaRng = .Range("A1", .Cells(Rows.Count, "A").End(xlUp))
End With
'Loop through the cells in the Criteria range
For Each cell In CriteriaRng
With Sheets("Sheet1")
'Firstly, remove the AutoFilter
.AutoFilterMode = False
'Apply the filter
.Range("A1:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=cell.Value
With .AutoFilter.Range
Set rng = Nothing
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With
'Remove the AutoFilter
.AutoFilterMode = False
End With
Next cell
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With
End Sub
У меня есть 2 листа:
Лист1 имеет список акций;Колонка 1 имеет биржевые сводки. Есть около 3000 строк данных
В Sheet2 есть список биржевых тикеров в столбце 1 (например, 10 биржевых тикеров), и каждый месяц этот список будет меняться
Что бы я хотел сделатьis:
a) Используйте тикеры акций в столбце Лист 2, чтобы найти одинаковые тикеры в столбце Лист 1 1
b) Затем обрежьте целые строки для этих тикеров в Листе 1
c) Затем вставьте все вырезанные строки в Sheet1, начиная с определенного номера строки, например, номер строки 2500
d) И когда я вставлю все вырезанные строки, я бы хотел, чтобы формулы были сохранены
Благодарю, если кто-то может помочь, поскольку я до сих пор не смог найти решение - много похожих случаев, но ничего, как указано выше. Я новичок в VBA. Я попытался адаптировать приведенный выше код, но не смог выполнить шаги с b) по d). Спасибо