Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.04.2010, 21:59   #1
alegu
Пользователь
 
Регистрация: 04.03.2010
Сообщений: 14
По умолчанию Сравнение дат и удаление невыделенных строк

Здравствуйте уважаемые участники форума!

Помогите, пожалуйста, решить проблему:

Имеется две книги Excel 2003 TestP.xls и TestSM.xls.
Проводится поиск по столбцам A,B,C,E TestSM.xls и J,K,L,N TestP.xls. Если все совпадает, то строка выделяется цветом. Это у меня работает при помощи макроса со следующим кодом (используется файл .xla):

Sub Main1()

Dim i As Long, j As Long, x As Range, a(), b()
Application.ScreenUpdating = False: Workbooks("TestP.xls").Sheets(1).Ac tivate
With Workbooks("TestSM.xls").Sheets(1)
Cells.Interior.ColorIndex = xlNone: .Cells.Interior.ColorIndex = xlNone
j = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
a = .Range(.[A2], .Cells(Rows.Count, "E").End(xlUp)).Value
ReDim b(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
b(i, 1) = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 5)
Next
.Range(.Cells(2, j), .Cells(UBound(b, 1) + 1, j)).Value = b
a = Range([J2], Cells(Rows.Count, "N").End(xlUp)).Value
For i = 1 To UBound(a, 1)
Set x = .Columns(j).Find(what:=a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 5), LookAt:=xlWhole)
If Not x Is Nothing Then
'Эта проверка не работает
'If Cells(i + 1, "I") > .Cells(x.Row, "L") Then
Rows(i + 1).Interior.ColorIndex = 6: .Rows(x.Row).Interior.ColorIndex = 6
'End If
End If
Next
End With


End Sub


Но мне необходимо, чтобы еще производилась проверка найденных данных по датам:
Если дата в столбце „I“ книги TestP.xls больше, чем дата в столбце „L“ книги TestSM.xls, то строка выделяется, в противном случае – нет. То, что у меня в коде закомментировано – не работает. Не могу понять, где ошибка?
Хотелось бы также в этот код интегрировать алгоритм удаления невыделенных строк, который бы начинал работать после выполнения основного алгоритма: все строки, которые выделяются цветом при поиске и сравнении - остаются, остальные –удаляются.
Все мои попытки решить эти задачи не увенчались успехом.
Буду очень благодарен за помощь.
Файлы TestP.xls и TestSM.xls приложены.

С уважением,
Александр
Вложения
Тип файла: zip TestP-SM.zip (15.9 Кб, 12 просмотров)
alegu вне форума Ответить с цитированием
Старый 12.04.2010, 23:34   #2
EugeneS
Форумчанин
 
Регистрация: 06.08.2009
Сообщений: 472
По умолчанию

Добрый вечер, проблема в значениях в столбце "L" файла "TestSM.xls" - это не даты, если перевести в даты, все в порядке
EugeneS вне форума Ответить с цитированием
Старый 12.04.2010, 23:49   #3
doober
Старожил
 
Аватар для doober
 
Регистрация: 02.05.2009
Сообщений: 3,907
По умолчанию

Код:


Sub Main1()

Dim i As Long, j As Long, x As Range, a(), b()
Application.ScreenUpdating = False: Workbooks("TestP.xls").Sheets(1).Activate
With Workbooks("TestSM.xls").Sheets(1)
Cells.Interior.ColorIndex = xlNone: .Cells.Interior.ColorIndex = xlNone
j = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
a = .Range(.[A2], .Cells(Rows.Count, "E").End(xlUp)).Value
ReDim b(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
b(i, 1) = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 5)
Next
.Range(.Cells(2, j), .Cells(UBound(b, 1) + 1, j)).Value = b
a = Range([J2], Cells(Rows.Count, "N").End(xlUp)).Value
For i = 1 To UBound(a, 1)
Set x = .Columns(j).Find(what:=a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 5), LookAt:=xlWhole)
If Not x Is Nothing Then

If CDate(Cells(i + 1, "I")) > CDate(.Cells(x.Row, "L")) Then
Rows(i + 1).Interior.ColorIndex = 6: .Rows(x.Row).Interior.ColorIndex = 6
End If
End If
Next
End With
Dim rng As Range: Dim n As Long
Set rng = Workbooks("TestP.xls").Sheets(1).UsedRange
For n = rng.Rows.Count To 2 Step -1
If rng.Cells(n, 1).Interior.ColorIndex <> 6 Then
rng.Rows(n).Delete
End If

Next

End Sub
Анализ,обработка данных Недорого
doober вне форума Ответить с цитированием
Старый 13.04.2010, 23:18   #4
alegu
Пользователь
 
Регистрация: 04.03.2010
Сообщений: 14
По умолчанию Спасибо!

Спасибо огромное за оперативное решение моей проблемы!
Особенно doober!!!!
Все работает. Проверил на файле из 17 000 строк - время обработки 3-4 минуты.

С уважением,
Александр
alegu вне форума Ответить с цитированием
Старый 14.04.2010, 06:18   #5
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Цитата:
Проверил на файле из 17 000 строк - время обработки 3-4 минуты.
Если, судя по объему данных, время выполнения макроса критично, и если не выделять строки цветом (ведь все не выделенные все равно удаляются), то, с позволения doober, немного изменив код, работу макроса можно значительно ускорить.
Код:
Sub Main1()
    Dim i As Long, j As Long, x As Range, y As Range, a(), b()
    Application.ScreenUpdating = False: Workbooks("TestP.xls").Sheets(1).Activate
    With Workbooks("TestSM.xls").Sheets(1)
        j = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
        a = .Range(.[A2], .Cells(Rows.Count, "E").End(xlUp)).Value
        ReDim b(1 To UBound(a, 1), 1 To 1)
        For i = 1 To UBound(a, 1)
            b(i, 1) = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 5)
        Next
        .Range(.Cells(2, j), .Cells(UBound(b, 1) + 1, j)).Value = b
        a = Range([J2], Cells(Rows.Count, "N").End(xlUp)).Value
        For i = 1 To UBound(a, 1)
            Set x = .Columns(j).Find(what:=a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 5), LookAt:=xlWhole)
            If x Is Nothing Then
                If y Is Nothing Then Set y = Rows(i + 1) Else Set y = Union(y, Rows(i + 1))
            Else
                If CDate(Cells(i + 1, "I")) <= CDate(.Cells(x.Row, "L")) Then
                    If y Is Nothing Then Set y = Rows(i + 1) Else Set y = Union(y, Rows(i + 1))
                End If
            End If
        Next: .Columns(j).Delete
    End With: y.EntireRow.Delete
End Sub
Пример во вложении.
Вложения
Тип файла: rar TestP-SM_2.rar (18.7 Кб, 13 просмотров)
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 14.04.2010, 15:12   #6
alegu
Пользователь
 
Регистрация: 04.03.2010
Сообщений: 14
По умолчанию

Спасибо SAS888!

Действительно, этот макрос работает значительно быстрее!
Логика для меня, конечно, сложновата...
Но выделения строк хотелось бы оставить, чтобы легче было сравнивать со второй книгой. Или удалять "лишние" данные из второй книги тоже?

Цитата:
.Columns(j).Delete
насколько я понял здесь удаляется вспомогательный столбец? Это здорово - я думал об этом, но не дошел пока...


Огромное спасибо еще раз!

С уважением,
Александр
alegu вне форума Ответить с цитированием
Старый 15.04.2010, 07:43   #7
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Так пойдет?
Код:
Sub Main1()
    Dim i As Long, j As Long, x As Range, y As Range, z As Range, a(), b()
    Application.ScreenUpdating = False: Workbooks("TestP.xls").Sheets(1).Activate
    With Workbooks("TestSM.xls").Sheets(1)
        .Cells.Interior.ColorIndex = xlNone: j = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
        a = .Range(.[A2], .Cells(Rows.Count, "E").End(xlUp)).Value
        ReDim b(1 To UBound(a, 1), 1 To 1)
        For i = 1 To UBound(a, 1)
            b(i, 1) = a(i, 1) & a(i, 2) & a(i, 3) & a(i, 5)
        Next
        .Range(.Cells(2, j), .Cells(UBound(b, 1) + 1, j)).Value = b
        a = Range([I2], Cells(Rows.Count, "N").End(xlUp)).Value
        For i = 1 To UBound(a, 1)
            Set x = .Columns(j).Find(what:=a(i, 2) & a(i, 3) & a(i, 4) & a(i, 6), LookAt:=xlWhole)
            If x Is Nothing Then
                If y Is Nothing Then Set y = Rows(i + 1) Else Set y = Union(y, Rows(i + 1))
            Else
                If CDate(a(i, 1)) <= CDate(.Cells(x.Row, "L")) Then
                    If y Is Nothing Then Set y = Rows(i + 1) Else Set y = Union(y, Rows(i + 1))
                Else
                    If z Is Nothing Then Set z = .Rows(x.Row) Else Set z = Union(z, .Rows(x.Row))
                End If
            End If
        Next: .Columns(j).Delete
        If Not z Is Nothing Then z.Interior.ColorIndex = 6
    End With
    If Not y Is Nothing Then y.EntireRow.Delete
End Sub
1. Уменьшено количество достаточно "медленных" операторов конкатенации.
2. При сравнении времени, сравнивается не ячейка с ячейкой, а ячейка с элементом массива, что также, чуть быстрее.
3. Добавлена подсветка совпавших строк во 2-м файле.
4. Устранена возможная ошибка при отсутствии совпадений.
Пример во вложении.
Вложения
Тип файла: rar TestP-SM_3.rar (18.7 Кб, 14 просмотров)
Чем шире угол зрения, тем он тупее.

Последний раз редактировалось SAS888; 15.04.2010 в 09:11.
SAS888 вне форума Ответить с цитированием
Старый 16.04.2010, 01:51   #8
alegu
Пользователь
 
Регистрация: 04.03.2010
Сообщений: 14
По умолчанию

Огромное спасибо SAS888!

Да, действительно, эта программа работает просто эамечательно! Проверил на файле в 17 000 строк (TestP.xls - второй поменьше) - время обработки меньше минуты, секунд 15-20. Просто супер!

Как я уже говорил, что логика для меня сложновата.
Знаю и понимаю, что у вас нет ни времени ни желания "пускаться" в объяснения. Но у меня возникла необходимость в небольшой доработке (не знал заранее):
Цитата:
Если дата в столбце „I“ книги TestP.xls больше, чем дата в столбце „L“ книги TestSM.xls, то строка выделяется, в противном случае – нет.
Сравниваться должны не только даты, которые больше, но и те, которые равны. Такой вариант присутствует в тестовых файлах (стр. 73 TestP.xls стр. 50 TestSM.xls)
Я пытался доработать ваш код по этому вопросу, но у меня не получается. Повторюсь - не до конца понимаю логику сравнения...

Если не трудно, подскажите, как добавить вышеописанное условие.


С уваженеим,
Александр

P.S.

Кажется, у меня получилось - сравнение без "=":

Цитата:
If CDate(a(i, 1)) < CDate(.Cells(x.Row, "L")) Then
Но я не понимаю, как это работает?....

Последний раз редактировалось alegu; 16.04.2010 в 02:21.
alegu вне форума Ответить с цитированием
Старый 16.04.2010, 06:00   #9
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Попробую пояснить.
1. В книге "TestSM.xls" создаем временный дополнительный столбец из сцепленных значений интересующих нас столбцов ("A:E"), используя массивы a и b. Располагаем этот столбец правее, после последнего использованного.
2. Из книги "TestP.xls" формируем массив a, содержащий все строки и столбцы для сравнения ("J:N"), а также столбец с временем ("I").
3. Организуем цикл по строкам массива a. Для каждой строки выполняем поиск сцепленных значений в сформированном нами доп. столбце.
4. Если совпадений нет (If x Is Nothing), то формируем диапазон y, содержащий не совпавшие строки для последующего удаления.
5. Если находим совпадение, то сравниваем элемент массива текущей строки, содержащий время с ячейкой столбца "L" найденной строки, которая также содержит время, предварительно переводя значения в формат "дата/время" (If CDate(a(i, 1)) <= CDate(.Cells(x.Row, "L")) Then...). И если время совпавшей строки из книги "TestP.xls" (a(i, 1)) меньши или равно времени совпавшей строки из книги "TestSM.xls" (.Cells(x.Row, "L")), то добавляем эту строку к диапазону y, т.е. такая строка тоже будет удалена. Иначе, формируем диапазон z из совпавших строк книги "TestSM.xls", которые удовлетворяют условию сравнения по времени.
6. После выхода из цикла, удаляем сформированный доп. столбец в книге "TestSM.xls" (.Columns(j).Delete), если диапазон z содержит хотя бы 1 значение, то окрашиваем все в желтый цвет (If Not z Is Nothing Then z.Interior.ColorIndex = 6), и если диапазон y содержит значения, то удаляем их (If Not y Is Nothing Then y.EntireRow.Delete). Такие проверки необходимы для того, чтобы в случае отсутствия совпадений не возникало ошибки.

Теперь, думаю, что Вы без труда, при необходимости, сможете самостоятельно изменять код макроса под свои нужды.
Чем шире угол зрения, тем он тупее.

Последний раз редактировалось SAS888; 16.04.2010 в 06:03.
SAS888 вне форума Ответить с цитированием
Старый 16.04.2010, 22:15   #10
alegu
Пользователь
 
Регистрация: 04.03.2010
Сообщений: 14
По умолчанию

Здравствуйте SAS888!

Цитата:
Попробую пояснить.
Вы все объяснили очень понятно и исчерпывающе!!! Больше вопросов нет и я уже все доработал так, как мне надо!

Огромное вам спасибо! Вы настоящий профессионал!

С уважением,
Александр
alegu вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
сравнение дат Алёна Microsoft Office Excel 8 03.07.2009 10:47
C#: Сравнение дат Veiron Общие вопросы .NET 1 08.06.2009 23:32
Сравнение дат в IBExpert SlavaSH SQL, базы данных 1 09.02.2009 16:53
Сравнение дат for_regist1 БД в Delphi 21 26.01.2009 01:29
сравнение дат Geddar Общие вопросы Delphi 2 04.06.2008 19:09