Сопоставление таблиц на поиск несовпадений

Автор aleks_yar, 13.02.2011, 21:30

« назад - далее »

aleks_yar

Здравствуйте. Первый раз встала проблема с обработкой большого объема данных в Excel. Есть сводная таблица за весь период работы (7 месяцев) и 7 листов с отчетами за каждый месяц. Есть предположение, что в сводной таблице были случайно удалены несколько строк, но в ежемесячные отчеты они попали. Необходимо сопоставить отчет за каждый месяц со сводной таблицей. В очетах содержатся только ключевые данные (из столбца "№ отправления"). В результате сопоставления необходимо выяснить, каких отправлений не хватает в сводной таблице. Я пытался сам записать макрос, который будет копировать ячейку из отчета, переходить на сводную таблицу, находить там значение буфера и помечать эту ячейку цветом. У меня не получается. Записанный макрос ищет конкретный номер отправления, а не любое значение из выбранной ячейки. Например, в ячейке отчета написано 123456 - макрос всегда будет искать 123456, а мне необходимо в следующий раз найти уже другое значение другой ячейки, на которую я перейду. В идеале макрос должен сопоставить сразу все отчеты со сводной таблицей и выдать итоговый отчет, в котором указать недостающие номера отправлений. Одно и то же отправление не может два раза попасть в отчеты. Сводная таблица и отчеты со временем будут дополняться, каждый месяц требуется сверка отчета со сводной таблицей. Буду очень благодарен за помощь. Заранее спасибо.

GWolf

Доброго дня!
Ну а где ВАШ макрос?!

Ведь проще подсказать что не так, чем рисовать с изнова.  ;)
Путей к вершине - множество. Этот один из многих!

aleks_yar

Спасибо за оперативность. Макрос записал.

GWolf

#3
Что то типа этого:

Sub sraVNenie()
'
' sraVNenie Макрос
' Макрос записан 14.02.2011 (1)
'
' Сочетание клавиш: Ctrl+q
'
   
   Dim noMOtprav As String
   Dim rez As Boolean
   Dim nR As Long
   
   noMOtprav = ""
   nR = 2
   With ThisWorkbook.ActiveSheet
       Do
           noMOtprav = .Cells(nR, 2).Text
           
           .Cells(nR, 2).Select
           
           rez = searchNO(noMOtprav)
           
           If rez = True Then '- нашел
               .Cells(nR, 2).Interior.ColorIndex = 6
           Else '- не нашел
           
           End If
           nR = nR + 1
       Loop While noMOtprav <> ""
   End With
End Sub

Function searchNO(noMOtprv As String) As Boolean
   Dim df As Object
   Dim ws As Worksheet
   
   searchNO = False
   
   With ThisWorkbook
       For Each ws In .Worksheets
           If ws.Name <> "Лист1" Then
               With ws.Cells
                   Set df = .Find(noMOtprv)
                   
                   If Not df Is Nothing Then
                       searchNO = True
                       ws.Cells(df.Row, df.Column).Interior.ColorIndex = 6
                       Exit For
                   End If
               End With
           End If
       Next
   End With
End Function


ну а чтобы убрать результаты работы макроса, можно использовать такой макрос:

Sub uborka()
'
' uborka Макрос
' Макрос записан 14.02.2011 (1)
'
' Сочетание клавиш: Ctrl+u
'
   With ThisWorkbook
       For Each ws In .Worksheets
'            If ws.Name <> "Лист1" Then
                ws.Cells.Interior.ColorIndex = xlNone
'            End If
       Next
   End With
End Sub


Удачи!
Путей к вершине - множество. Этот один из многих!

aleks_yar

Ура. Работает. Огромное спасибо и респект.

GWolf

Цитата: aleks_yar от 14.02.2011, 21:29
Ура. Работает. Огромное спасибо и респект.

Пожалуйста! - Обращайтесь.
Путей к вершине - множество. Этот один из многих!