Поиск скопированного значения MACRO

Question

У меня есть два листа:

1. База данных

2. Макрослой: в нем есть строка с датами, которые будут заголовками таблицыпосле макроса.

Цель: в листе макроса взять значение первой даты и найти его положение в листе базы данных.Затем на листе базы данных скопируйте весь столбец, соответствующий ранее скопированной дате.

Я понимаю, что код должен выглядеть примерно так:

    Sheets("Macro").Select
    Range("K3").Select
    Selection.Copy
    Sheets("Database").Select
    Cells.Find(What:=Selection.PasteSpecial xlValues, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Macro").Select
    ActiveSheet.Paste

Этот код не работает,потому что поисковая часть не сделана хорошо, я буду признателен за некоторые исправления

Answer 1

Прокручивать даты заголовка в листе Macro.Если их можно найти в строке заголовка рабочего листа базы данных, скопируйте этот столбец на рабочий лист макроса под заголовком.

sub getDateData()

    dim h as long, wsdb as worksheet, m as variant, arr as variant

    set wsdb = worksheets("database")

    with worksheets("macro")

        for h=1 to .cells(1, .columns.count).end(xltoleft).column

            m = application.match(.cells(1, h).value2, wsdb.rows(1), 0)

            if not iserror(m) then
                arr = wsdb.range(wsdb.cells(2, m), wsdb.cells(rows.count, m).end(xlup)).value
                .cells(2, h).resize(ubound(arr, 1), ubound(arr, 2)) = arr
            end if

        next h
    end with

end sub

Answer 2

Что-то в этом духе.

Прочитайте это , чтобы узнать о преимуществах неиспользования выбора или активации.

При использовании Find всегда сначала проверяйте, что вашПоисковый термин найден, чтобы избежать ошибки.Например, вы не можете активировать несуществующую ячейку.

Sub x()

Dim r As Range

With Sheets("Database")
    Set r = .Cells.Find(What:=Sheets("Macro").Range("K3").Value, lookAt:=xlPart, _
                        SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
    If Not r Is Nothing Then
        Range(r, r.End(xlDown)).Copy Sheets("Macro").Range("A1")
    End If
End With

End Sub