Копировать данные, имеющие дату между двумя заданными датами на новый рабочий лист с помощью VBA
В этой статье мы создадим макрос для извлечения данных из рабочего листа необработанных данных на новый рабочий лист на основе указанного диапазона дат.
Исходные данные состоят из трех столбцов. Первый столбец содержит даты, второй столбец содержит имена агентов, а третий столбец содержит количество продаж, сделанных агентом в этот конкретный день.
Перед запуском макроса от пользователя требуются два ввода. Пользователь должен определить дату начала и окончания. На основе указанных дат макрос извлечет данные между указанным диапазоном дат на новый рабочий лист.
После указания дат начала и окончания пользователь должен нажать кнопку «Отправить», чтобы выполнить макрос.
При запуске макроса он будет сортировать данные на листе «RawData» на основе столбца даты и извлекать данные на основе указанного диапазона дат во вновь вставленный рабочий лист.
Логическое объяснение
Макрос принимает входные данные для дат начала и окончания из ячеек J8 и J9 соответственно. Этот макрос сначала сортирует данные на листе «RawData» на основе столбца A в порядке возрастания. Мы отсортировали данные по значениям дат, чтобы мы могли скопировать данные в один диапазон после применения фильтра для определенного диапазона.
После сортировки данных примените к ним фильтр. Примененный фильтр основан на двух условиях: первое условие — значение в столбце A должно быть больше или равно дате начала, а второе условие — значение в столбце A должно быть меньше или равно дате окончания.
После применения фильтра новый рабочий лист вставляется, а отфильтрованные данные копируются и вставляются в него.
Объяснение кода
Диапазон («A1»). CurrentRegion.Sort key1: = Range («A1»), order1: = xlAscending, Header: = xlYes Указанный выше код используется для сортировки данных в заданном диапазоне. Key1 указывает столбец, на основе которого будут сортироваться данные. Порядок сортировки обеспечивается order1. Мы уже определили порядок возрастания. Чтобы определить порядок убывания, можно использовать константу xlDescending. Заголовок используется для указания, содержит ли диапазон данных заголовок.
Range («A1»). CurrentRegion.AutoFilter Поле: = 1, Criteria1: = «> =» & StartDate, Operator: = xlAnd, Criteria2: = «⇐» & EndDate Указанный выше код используется для применения фильтра к диапазону данных . Поле1 указывает номер столбца, к которому будет применен фильтр. Criteria1 и Criteria2 определяют условия, по которым данные будут фильтроваться.
Оператор указывает оператор, который будет использоваться между двумя условиями.
Рабочие листы.Добавить после: = Рабочие листы (Worksheets.Count)
Приведенный выше код используется для вставки нового листа после последнего листа в книге.
Коды легко понять, так как я добавил комментарии вместе с кодами в макрос.
Пожалуйста, следуйте за кодом ниже
Sub CopyDataBasedOnDate() 'Disabling screen updates Application.ScreenUpdating = False 'Declaring two variables of Date data type Dim StartDate, EndDate As Date 'Declaring variable for worksheet object Dim MainWorksheet As Worksheet 'Initializing the Date variables with starting date from cell J8 'and end date from cell J9 of "Macro" sheet StartDate = Sheets("Macro").Range("J8").Value EndDate = Sheets("Macro").Range("J9").Value 'Initializing worksheet object with "RawData" worksheet Set MainWorksheet = Worksheets("RawData") 'Activating the worksheet object MainWorksheet.Activate 'Sorting the data by date in column A in ascending order Range("A1").CurrentRegion.Sort _ key1:=Range("A1"), order1:=xlAscending, _ Header:=xlYes 'Filter the data based on date range between starting date and end date Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:= _ ">=" & StartDate, Operator:=xlAnd, Criteria2:="<=" & EndDate 'Copy the filter data ActiveSheet.AutoFilter.Range.Copy 'Inserting new worksheet after the last worksheet in the workbook Worksheets.Add after:=Worksheets(Worksheets.Count) 'Pasting the copied data ActiveSheet.Paste 'Auto adjusting the size of selected columns Selection.Columns.AutoFit Range("A1").Select 'Activating the "RawData" sheet MainWorksheet.Activate 'Removing filter from the worksheet which we applied earlier Selection.AutoFilter Sheets("Macro").Activate End Sub
Если вам понравился этот блог, поделитесь им с друзьями на Facebook и Facebook.
Мы будем рады услышать от вас, дайте нам знать, как мы можем улучшить нашу работу и сделать ее лучше для вас. Напишите нам на [email protected]