Excel 2003 VBA - поиск даты и перемещение соответствующих данных

Question

Мне нужно автоматизировать процесс, который не является одноразовым событием, ~ 500 объектов, каждый с более чем 100 активами, которые все запланированы на разные даты в течение года для завершения.У меня есть Рабочая тетрадь с моим основным / исходным листом, а также 12-месячные листы (январь, февраль, март, ... дек).Мне нужен какой-то код, который позволил бы мне искать определенную дату и отправлять ее, а также другие соответствующие данные той же строки на соответствующий лист.

Например, у меня есть актив, который долженна техническое обслуживание в июне, 17.06.11.Мне нужно, чтобы Excel искал его, используя только месяц, и перемещая этот актив, а также его имя, описание, стоимость и т. Д. На вкладку «Июнь».Мне удалось найти его для поиска активов в поисках «6 /», однако он не может найти активы с датой 17.06.11.Он копирует все необходимые данные и пытается переместить их на соответствующий лист, когда он делает эту попытку, появляется код ошибки Microsoft Visual Basic 400.Есть идеи?Вся помощь оценена.

Answer 1

посмотрим, поможет ли это ...

Private Sub FindCells()
    '' step 1, find all the rows containing your date (June 2011 dates hardcoded in this example)
    Dim CollectionOfRowRanges As New Collection
    Dim ws As Worksheet
    Dim rgCell As Range
    For Each ws In ThisWorkbook.Worksheets
        For Each rgCell In ws.UsedRange.Cells
            If IsDate(rgCell.Text) Then
                If Month(CDate(rgCell.Value)) = 6 And Year(CDate(rgCell.Value)) = 2011 Then
                    '' for debugging only ... watch and make sure it stops at the right places
                    ws.Activate
                    rgCell.Select
                    Stop
                    '' end of debug code
                    Call CollectionOfRowRanges.Add(rgCell.EntireRow)
                End If
            End If
        Next rgCell
    Next ws
    '' step 2, copy the rows to a new wb
    Set ws = Workbooks.Add.Sheets(1)
    ws.Name = "June 2011 Rows"
    Dim rgRow As Range
    Set rgCell = ws.Cells(1, 1)
    For Each rgRow In CollectionOfRowRanges
        Call rgRow.Copy
        Call rgCell.EntireRow.PasteSpecial(xlPasteValues)
        Set rgCell = rgCell.Offset(1)
    Next rgRow
End Sub