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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 23.07.2009, 11:05   #1
hybrid84
 
Регистрация: 20.07.2009
Сообщений: 6
По умолчанию Поиск и удаление совпадающих строк в разных листах

Добрый день, уважаемые форумчане.

Проблема следующая: есть два листа примерно по 20000 строк.
Большая часть записей совпадает, отличаются примерно 60. Искать их вручную - идиотизм.

Поиск ведется по строковому сожержанию столба "A" обоих листов.
Пример записи этого столбца - 95/21/3682/7/2009.
При полном совпадении этих записей обе строки удаляются.

В результате выполнения макроса должны остаться записи которые есть только в одном листе.
hybrid84 вне форума Ответить с цитированием
Старый 23.07.2009, 11:48   #2
hybrid84
 
Регистрация: 20.07.2009
Сообщений: 6
По умолчанию

Мое решение выглядит так:

Sub Ñðàâíåíèå_ëèñòîâ_0_1()
Application.ScreenUpdating = False

Dim s1, s2 As String
Dim i, n As Integer

For i = 1 To 20000

s1 = Worksheets("Ëèñò1").Cells(i, 1).Text
For n = 1 To 20000

s2 = Worksheets("Ëèñò2").Cells(n, 1).Text
If InStr(s2, s1) Then Worksheets("Ëèñò1").Rows(i).Delete Worksheets("Ëèñò2").Rows(n).Delete


Next n

Next i

End Sub
hybrid84 вне форума Ответить с цитированием
Старый 23.07.2009, 12:20   #3
hybrid84
 
Регистрация: 20.07.2009
Сообщений: 6
По умолчанию

Гы гы ))
ну млин даете,
такая чушь написана. Все смотрят никто ничего не говорит.
Попалась наконец то путняя литература.
Ответ:
Sub DelTel()
Dim iLastRow As Long, i As Long
Dim c As Range
Dim iTel As String
iLastRow = Sheets("Ëèñò1").Cells(11, 1).End(xlUp).Row
For i = 2 To iLastRow
iTel = Sheets("Ëèñò1").Cells(i, 1)
Set c = Sheets("Ëèñò2").Columns(1).Find(wha t:=iTel, lookat:=xlWhole)
If Not c Is Nothing Then c.EntireRow.Delete
Next i
MsgBox "Done!", vbInformation, ""
End Sub

единственное... как удаление строки с индексом i в первом листе лучше сделать?
hybrid84 вне форума Ответить с цитированием
Старый 23.07.2009, 12:22   #4
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

1. Ваше решение работать не будет, т.к. при использовании цикла For...Next, при удалении строки будет нарушаться счет цикла. В подобных случаях строки требуется перебирать снизу вверх.
2. Если сделать правильно, то будет о-о-очень медленно.
Предлагаю что-нибудь такое:
Код:
Sub Main()
    Dim i As Long, j As Long, k As Long, x As New Collection, a, b, c, d
    a = Sheets(1).UsedRange.Value: b = Sheets(2).UsedRange.Value
    ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2)): ReDim d(1 To UBound(b, 1), 1 To UBound(b, 2))
    Application.ScreenUpdating = False: On Error Resume Next
    For i = 1 To UBound(a, 1)
        x.Add a(i, 1), CStr(a(i, 1))
    Next
    On Error GoTo 0: k = 1
    For i = 1 To UBound(b, 1)
        On Error Resume Next
        x.Add b(i, 1), CStr(b(i, 1))
        If Err = 0 Then
            For j = 1 To UBound(d, 2)
                d(k, j) = b(i, j)
            Next
            k = k + 1
        Else: On Error GoTo 0
        End If
    Next
    Sheets(2).UsedRange.Value = d: Set x = Nothing
    For i = 1 To UBound(b, 1)
        x.Add b(i, 1), CStr(b(i, 1))
    Next
    On Error GoTo 0: k = 1
    For i = 1 To UBound(a, 1)
        On Error Resume Next
        x.Add a(i, 1), CStr(a(i, 1))
        If Err = 0 Then
            For j = 1 To UBound(c, 2)
                c(k, j) = a(i, j)
            Next
            k = k + 1
        Else: On Error GoTo 0
        End If
    Next
    Sheets(1).UsedRange.Value = c
End Sub
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 23.07.2009, 12:28   #5
hybrid84
 
Регистрация: 20.07.2009
Сообщений: 6
По умолчанию

Спасибо большое... честное слово спасибо
Титанический труд.
Я сегодня первый раз в жизни пишу макросы в Excel,
синтаксис специфичный. бейсик мля.
ребят задача почти решена, просто одну строчку подскажите пожалуйста. SAS888 еще раз спасибо
hybrid84 вне форума Ответить с цитированием
Старый 23.07.2009, 13:19   #6
WIC
Форумчанин Подтвердите свой е-майл
 
Регистрация: 21.09.2007
Сообщений: 138
По умолчанию

Без макросов нельзя было обойтись?

ВПР, фильтром например...
WIC вне форума Ответить с цитированием
Старый 23.07.2009, 13:40   #7
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

2 WIC
Цитата:
Без макросов нельзя было обойтись?
ВПР, фильтром например...
Как уже кто-то на нашем форуме говорил (извиняюсь, не помню кто), что прежде чем критиковать, нужно что-то предложить. Как Вы, например, при помощи формул, удалите строку? Или как Вы себе представляете подобный фильтр?

hibrid84
Цитата:
просто одну строчку подскажите пожалуйста
Какую? Что не так? Что не понятно?
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 23.07.2009, 14:04   #8
hybrid84
 
Регистрация: 20.07.2009
Сообщений: 6
По умолчанию

Да в общем то все ок ))
Только буду разбираться как работеат твой макрос еще долго ))
Но спасибо все замечательно, правда он не удаляет из первого листа ничего, но это уже и не нужно )

слушай а можно в твой макрос добавить еще проверку?
Такого типа: если нашел совпадение,
то проверяет совпадение
по значению другой ячейки этих же строк,
ищет он по первой, а совпадение проверяет по второй.
если совпадение нет, то ищет следующее совпадение.
Если совпадений нет вообще, то не удаляет.
hybrid84 вне форума Ответить с цитированием
Старый 23.07.2009, 15:59   #9
WIC
Форумчанин Подтвердите свой е-майл
 
Регистрация: 21.09.2007
Сообщений: 138
По умолчанию

простите...

вручную удалять.
Идею, думаю, понятна: столбец добавляем. Через ВПР ищем совпадение на 2-м листе. Формула выдаст или значение или ошибку.
Фильтр на не ошибки, выделить-удалить строки.

Если уникальные значения на 2-х листах, то немного доработать...по тому же принципу.
WIC вне форума Ответить с цитированием
Старый 24.07.2009, 04:59   #10
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Цитата:
ищет он по первой, а совпадение проверяет по второй.
Т.е. нужно, чтобы строки удалялись в том случае, если в строках совпадают ячейки в столбцах "A" и "B"?
Цитата:
правда он не удаляет из первого листа ничего
Если есть совпадающие значения, то такого быть не может. Прикрепите пример из нескольких строк на 2-х листах, тогда работа макроса будет нагляднее.
Чем шире угол зрения, тем он тупее.

Последний раз редактировалось SAS888; 24.07.2009 в 05:06.
SAS888 вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
МАКРОС НА ПОИСК, СУММИРОВАНИЕ И УДАЛЕНИЕ ПОВТОРЯЮЩИХСЯ СТРОК provodnikam Microsoft Office Excel 14 19.02.2015 07:53
удаление строк alexk Microsoft Office Excel 24 15.02.2011 08:34
Одновременное удаление записей в разных таблицах Lkhasa БД в Delphi 9 16.12.2010 13:21
Удаление строк Dr.Badnezz Общие вопросы Delphi 1 07.10.2008 15:22
удаление строк Dime_x Microsoft Office Excel 2 07.10.2008 13:38