Вырезать целые строки (с формулами) в Sheet1 на основе значений в Sheet2 и вставить вырезанные строки в конкретный номер строки в Sheet1 - PullRequest
0 голосов
/ 05 ноября 2019
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). Спасибо

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...