Как скопировать данные между двумя определенными датами на новый лист с помощью VBA?

Question

Я пытаюсь скопировать данные из рабочей таблицы «Данные» в уже созданную рабочую таблицу с именем «DateData». Я хочу, чтобы пользователь мог вводить дату начала («L15») и дату окончания («L16») в отдельном листе под названием «Нет ввода». При нажатии кнопки ... Затем данные на рабочем листе «Данные» помещаются в рабочий лист «Дата-данные», включая только записи между этими датами (включая дату начала и дату входа). Я надеюсь, что это имеет смысл, ха-ха

Я пробовал ниже, но продолжаю получать ошибки. Первый из них - «Метод сортировки класса Range не удался 1004». Приведенный ниже код также не использует предустановленную рабочую таблицу для копирования данных, но создает лист в конце всех рабочих таблиц (что мне не нужно).

Рабочая таблица «Данные» содержит заголовки, все в строке 1и данные начинаются с A2 и далее ... У него есть 19 столбцов заголовков (поэтому данные заполнены), и дата, которую я хочу найти, находится в столбце G..G1 = Заголовок, G2 = Дата начинается. Формат даты = дд / мм / гггг

Как мне поступить? Любая помощь была бы так благодарна. Спасибо

Private Sub CommandButton2_Click()

Application.ScreenUpdating = False

Dim StartDate, EndDate As Date
Dim MainWorksheet As Worksheet

StartDate = Sheets("NoEntry").Range("L15").Value
EndDate = Sheets("NoEntry").Range("L16").Value

Set MainWorksheet = Worksheets("Data")

MainWorksheet.Activate

Range("G1").CurrentRegion.Sort key1:=Range("G1"), order1:=xlAscending, Header:=xlYes

Range("G1").CurrentRegion.AutoFilter Field:=7, Criteria1:=">=" & StartDate, Operator:=xlAnd,        
Criteria2:="<=" & EndDate

ActiveSheet.AutoFilter.Range.Copy

Worksheets.Add after:=Worksheets(Worksheets.Count)

ActiveSheet.Paste

Selection.Columns.AutoFit

Range("G1").Select

MainWorksheet.Activate

Selection.AutoFilter

Sheets("NoEntry").Activate

End Sub

"DateData"

"Данные"

Так, как вы можете видеть из "Данные«Я отсортировал данные, но поскольку они содержат пробелы, они находятся внизу (так как в столбце G для них нет дат). Это было до проверки, поэтому это произошло

И что копирует на лист «DateData» только записи с пустыми датами.

Извините за записи, заполненные черным, поскольку они являются частной информацией. Я надеюсь, что это имеет смысл.

Answer 1

Не используйте константу .Select и .Activate. Вместо этого управляйте процессами с Set переменными или в With контексте. Кроме того, метод фильтра копирования должен обрабатываться по-разному, а именно для видимых и непустых результатов ячейки отфильтрованного рабочего листа.

Dim StartDate As Date, EndDate As Date
Dim MainWorksheet As Worksheet, NewWorkSheet As Worksheet

StartDate = Sheets("NoEntry").Range("L15").Value
EndDate = Sheets("NoEntry").Range("L16").Value

Set MainWorksheet = Worksheets("Data")

With MainWorksheet
    ' SORT RANGE
    .Range("G1").CurrentRegion.Sort key1:=.Range("F1"), order1:=xlAscending, Header:=xlYes

    Set NewWorkSheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    With .Range("$A:$G")
        ' SORT RANGE 
        .AutoFilter Field:=7, Criteria1:=">=" & StartDate, Operator:=xlAnd, _
                              Criteria2:="<=" & EndDate
        ' COPY VISIBLE AND NON-BLANK CELLS TO NEW WORKSHEET     
         Application.Intersect(.SpecialCells(xlCellTypeVisible), _
                               .SpecialCells(xlCellTypeConstants)).Copy _
                               Destination:=NewWorkSheet.Range("A1")
    End With        
    ' REMOVE FILTER
    .Cells.AutoFilter
End With

Sheets("NoEntry").Activate
Set MainWorksheet = Nothing: Set NewWorkSheet = Nothing

Answer 2

Во-первых, см. Как избежать использования Select в Excel VBA , чтобы узнать, как избежать использования select в вашем коде. Практически нет необходимости в его использовании.

См. Ниже примечания о коде, который я предоставляю (сейчас тестируется!).

1) У вас возникла проблема, когда добавляется рабочая таблица ивы не знаете, как и почему, и вы не уверены в том, куда вы направили свои данные. Чтобы преодолеть это, обычной практикой является явное определение объектов рабочей таблицы. Это облегчит вам понимание, а также уменьшит вероятность ошибок. Я квалифицировал рабочие листы как wsData для «Рабочего листа данных», wsDate для «Рабочего листа DateData» и wsNoEntry для «Рабочего листа без ввода». Видите ли вы, как легко это понять сейчас?

2) Убедитесь, что даты в вашем наборе данных хранятся как значения типа «Дата». Вы можете сделать это на ленте для форматирования чисел.

3) Я решил использовать массив для циклического прохождения. В зависимости от того, насколько велик ваш набор данных, это будет гораздо более быстрый способ циклического прохождения для получения даты начала и окончания

4) Этот подход предполагает, что ваши данные сортируются по столбцу Дата (G)

Sub CopyDataUsingDateRange()

    Application.ScreenUpdating = False

    Dim wsData As Worksheet, wsDate As Worksheet, wsNoEntry As Worksheet
    Dim dSDate As Date, dEDate As Date
    Dim lRowStart As Long, lRowEnd As Long
    Dim aData() As Variant
    Dim i As Long


    'set the worksheet objects
    Set wsData = ThisWorkbook.Sheets("Data")
    Set wsDate = ThisWorkbook.Sheets("DateData")
    Set wsNoEntry = ThisWorkbook.Sheets("No Entry")

    'required variables
    dSDate = wsNoEntry.Range("L15").Value
    dEDate = wsNoEntry.Range("L16").Value

    'set the array - you can make this dynamic!
    aData = wsData.Range("A1:Z1000").Value

    'for loop to find start
    For i = 1 To 1000
        If aData(i, 7) = dSDate Then
            lRowStart = i
            Debug.Print "Start row = " & lRowStart
            Exit For
        End If
    Next i

    'now loop backwards to find end date
    For i = 1000 To 1 Step -1
        If aData(i, 7) = dEDate Then
            lRowEnd = i
            Debug.Print "End row = " & lRowEnd
            Exit For
        End If
    Next i

    'now we have start and end dates
    'going to use copy/ paste for simplicity
    wsData.Range("A" & lRowStart, "Z" & lRowEnd).Copy
    'paste in date sheet
    wsDate.Range("A1").PasteSpecial Paste:=xlPasteValues
    'clear clipboard
    Application.CutCopyMode = False

    Application.ScreenUpdating = True

End Sub

Надеюсь, это поможет, в основном с пониманием, чтобы вы могли использовать для будущего использования!