excel-vba - ячейку - макрос переноса данных с одного листа на другой




Есть ли макрос для условного копирования строк на другой рабочий лист? (4)

Есть ли макрос или способ условно скопировать строки из одного листа в другой в Excel 2003?

Я собираю список данных из SharePoint через веб-запрос в пустой лист в Excel, а затем я хочу скопировать строки для определенного месяца на конкретный рабочий лист (например, все данные июля из листа SharePoint на Июль, все июньские данные из листа SharePoint на рабочий лист Jun и т. Д.).

Пример данных

Date - Project - ID - Engineer
8/2/08 - XYZ - T0908-5555 - JS
9/4/08 - ABC - T0908-6666 - DF
9/5/08 - ZZZ - T0908-7777 - TS

Это не одноразовое упражнение. Я пытаюсь собрать панель инструментов, чтобы мой босс мог вытащить последние данные из SharePoint и увидеть ежемесячные результаты, поэтому он должен иметь возможность делать это все время и организовывать его чисто.


Вот еще одно решение, которое использует некоторые встроенные функции даты VBA и сохраняет все данные даты в массиве для сравнения, что может дать лучшую производительность, если вы получите много данных:

Public Sub MoveData(MonthNum As Integer, FromSheet As Worksheet, ToSheet As Worksheet)
    Const DateCol = "A" 'column where dates are store
    Const DestCol = "A" 'destination column where dates are stored. We use this column to find the last populated row in ToSheet
    Const FirstRow = 2 'first row where date data is stored
    'Copy range of values to Dates array
    Dates = FromSheet.Range(DateCol & CStr(FirstRow) & ":" & DateCol & CStr(FromSheet.Range(DateCol & CStr(FromSheet.Rows.Count)).End(xlUp).Row)).Value
    Dim i As Integer
    For i = LBound(Dates) To UBound(Dates)
        If IsDate(Dates(i, 1)) Then
            If Month(CDate(Dates(i, 1))) = MonthNum Then
                Dim CurrRow As Long
                'get the current row number in the worksheet
                CurrRow = FirstRow + i - 1
                Dim DestRow As Long
                'get the destination row
                DestRow = ToSheet.Range(DestCol & CStr(ToSheet.Rows.Count)).End(xlUp).Row + 1
                'copy row CurrRow in FromSheet to row DestRow in ToSheet
                FromSheet.Range(CStr(CurrRow) & ":" & CStr(CurrRow)).Copy ToSheet.Range(DestCol & CStr(DestRow))
            End If
        End If
    Next i
End Sub

Если это просто одноразовое упражнение, в качестве более простой альтернативы, вы можете применить фильтры к исходным данным, а затем скопировать и вставить отфильтрованные строки в новый лист?


Я бы сделал это вручную:

  • Использовать данные - AutoFilter
  • Применение настраиваемого фильтра на основе диапазона дат
  • Скопируйте отфильтрованные данные в соответствующий лист месяца
  • Повторите для каждого месяца

Ниже приведен код для выполнения этого процесса через VBA.

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

    Sub SeperateData()

    Dim vMonthText As Variant
    Dim ExcelLastCell As Range
    Dim intMonth As Integer

   vMonthText = Array("January", "February", "March", "April", "May", _
 "June", "July", "August", "September", "October", "November", "December")

        ThisWorkbook.Worksheets("Sharepoint").Select
        Range("A1").Select

    RowCount = ThisWorkbook.Worksheets("Sharepoint").UsedRange.Rows.Count
'Forces excel to determine the last cell, Usually only done on save
    Set ExcelLastCell = ThisWorkbook.Worksheets("Sharepoint"). _
     Cells.SpecialCells(xlLastCell)
'Determines the last cell with data in it


        Selection.EntireColumn.Insert
        Range("A1").FormulaR1C1 = "Month No."
        Range("A2").FormulaR1C1 = "=MONTH(RC[1])"
        Range("A2").Select
        Selection.Copy
        Range("A3:A" & ExcelLastCell.Row).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Calculate
    'Insert a helper column to determine the month number for the date

        For intMonth = 1 To 12
            Range("A1").CurrentRegion.Select
            Selection.AutoFilter Field:=1, Criteria1:="" & intMonth
            Selection.Copy
            ThisWorkbook.Worksheets("" & vMonthText(intMonth - 1)).Select
            Range("A1").Select
            ActiveSheet.Paste
            Columns("A:A").Delete Shift:=xlToLeft
            Cells.Select
            Cells.EntireColumn.AutoFit
            Range("A1").Select
            ThisWorkbook.Worksheets("Sharepoint").Select
            Range("A1").Select
            Application.CutCopyMode = False
        Next intMonth
    'Filter the data to a particular month
    'Convert the month number to text
    'Copy the filtered data to the month sheet
    'Delete the helper column
    'Repeat for each month

        Selection.AutoFilter
        Columns("A:A").Delete Shift:=xlToLeft
 'Get rid of the auto-filter and delete the helper column

    End Sub

Это частично псевдокод, но вам нужно что-то вроде:

rows = ActiveSheet.UsedRange.Rows
n = 0

while n <= rows
  if ActiveSheet.Rows(n).Cells(DateColumnOrdinal).Value > '8/1/08' AND < '8/30/08' then
     ActiveSheet.Rows(n).CopyTo(DestinationSheet)
  endif
  n = n + 1
wend




worksheet