powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / сопоставление данных на двух листах
25 сообщений из 45, страница 1 из 2
сопоставление данных на двух листах
    #36542375
VNI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VNI
Гость
Нужно оптимизировать такой макрос:
сопоставляет данные одного листа с данными другого листа и дополняет первый лист колонкой с соответствующими значениями со второго листа.
вот код
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
Sub Admin()
    Sheets("(1)").Cells( 9 ,  2 ).Value = Time()
    Sheets("(1)").Select
    i_z = Sheets("22").Cells( 1 ,  1 ).Value
    i_nvs = Sheets("(1)").Cells( 9 ,  1 ).Value
    
    For i =  14  To i_nvs
    
     If (Cells(i,  18 ).Value <> "") And (Cells(i,  17 ).Value = "") Then
     
        Find = Trim(Cells(i,  18 ).Value)
        'kol2 = 0
        For j =  5  To i_z Step  1 
        If Trim(Sheets("22").Cells(j,  8 ).Value) = Find Then
        Sheets("(1)").Cells(i,  17 ).Value = Sheets("22").Cells(j,  6 ).Value
        If Sheets("22").Cells(j,  5 ).Value <> Sheets("(1)").Cells(i,  12 ).Value Then
        Sheets("(1)").Cells(i,  17 ).Font.ColorIndex =  5 
        End If
      Exit For
        End If
       
        Next j
    

    
        Sheets("(1)").Cells( 9 ,  3 ).Value = Time()
            
         
    End If
    Next i
    
End Sub

выполняется жутко долго. количество записей и на первом листе и на втором - по 40-60 тыс.
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542394
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: VNI
> выполняется жутко долго. количество записей и на первом листе и на втором - по 40-60 тыс.

А просто прописать формулу проверки в отдельном столбце, и по значению #Н/Д отфильтровать нужные для копирования не
пробовал?

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542401
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
VNI,
В начале кода поместить такой код:
Код: plaintext
1.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


В конце кода поместить такой код:
Код: plaintext
1.
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542403
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вообще-то такие вещи на таких объемах данных делаются через СУБД.

Первое, что приходит в голову, если нет возможности использовать СУБД - отсортировать исходные данные на личтах по возрастанию, и организовать два одновременно перемещающихся курсора по ним. Если вдруг данные под курсорами становятся несинхронными - вычлненить несоответствие, синхронизировать курсоры и продолжать. Тогда это будет в один проход реализовано и уж точно на пару порядков быстрее. Вопрос только, сколько займет сама сортировка.
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542520
VNI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VNI
Гость
Игорь Горбонос
А просто прописать формулу проверки в отдельном столбце, и по значению #Н/Д отфильтровать нужные для копирования не
пробовал?

не пробовалА. в VBA - самоучка. выкручиваюсь как могу) можно поподробнее?
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542524
VNI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VNI
Гость
Djon Player,
спасибо, попробую - может действительно будет быстрее. пока выполняется около 5,5 часов
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542535
VNI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VNI
Гость
Shocker.Pro,
пока только есть такой вариант. над вариантом через СУБД - тоже работаем.
с курсорами боюсь не справлюсь сама, но попробую.

А вот есть же .find метод и ищет он быстро, пробовали на другой задаче. вот из хелпа:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
Example
This example finds all cells in the range A1:A500 on worksheet one that contain the value  2  and changes it to  5 .

With Worksheets( 1 ).Range("a1:a500")
    Set c = .Find( 2 , lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Value =  5 '********
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

Только как с помощью него вместо 5 из примера проставлять значение столбца по строке в которой найдено совпадение?
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542546
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
VNIзначение столбца

c.Row или c.Range.Row
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542550
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Shocker.ProVNIзначение столбца

c.Row или c.Range.Row

Виноват - столбец
c.Column или c.Range.Column
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542554
VNI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VNI
Гость
так это будет на первом листе (или я запуталась?). а мне надо на втором.
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542589
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
VNI,

В двух словах уточните на каком листе ведётся поиск, на какой лист помещать значение, откуда это значение взять. Ну и другие нюансы которые может я забыл спросить.
А то над самым первым кодом к вечеру уже лень голову ломать и думать, что именно он делает.
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542600
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
VNIтак это будет на первом листе (или я запуталась?). а мне надо на втором.

Вы просто вопрос непонятно задали.
с - результат поиска методом Find
соответственно с.Row - строка, где найдено значение, c.Column - столбец.

С Djon Player я не согласен - отключение обновления экрана скорее всего не поможет, потому что у вас в цикле ничто на экране не обновляется.

Метод .Find вместо внутреннего цикла ускорит работу раза в два.

Метод двух курсоров на пару порядков (не считая времени на сортировку).
К сожалению, сегодня не успею сделать вам пример, могу попробовать завтра, если никто больше не предложит и если это вам действительно нужно.
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542605
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: VNI
> не пробовалА. в VBA - самоучка. выкручиваюсь как могу) можно поподробнее?

Дай книгу с небольшим количеством данных, я покажу

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542608
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Shocker.Pro,

В коде присутствует изменения цвета ячеек и установка значений, поэтому какой-то прирост производительности от отключения обновления экрана всё равно будет, вопрос лишь в том, на сколько он большой этот прирост.
Я например задачу до конца не понял, а из того что понял, мне почему-то кажется, что я бы решил эту задачу в помощью ВПР.
Вобщем надо уточнение задачи, лучше чтобы был файл.
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542638
VNI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VNI
Гость
спасибо за такое участие)
В двух словах о задаче:
есть столбец с уникальными значениями на первом листе - пусть будет Лист1. столбец 1, и такой же столбец на втором (Лист 2.столбец 2).
Лист 1 содержит все данные, а лист 2 периодически меняется и нужно значения из листа 2 проставлять в соответствующие строки первого листа. Соответствие по уникальному полю.
Нужно в столбец на первом листе Лист 1. Столбец 2 - записать значения из Листа 2.столбец 3.
По-моему я еще больше всех запутала сейчас.
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542644
VNI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VNI
Гость
книгу с данными обязательно подготовлю - смогу выложить только завтра.
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542655
VNI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VNI
Гость
а по поводу выделения цветом - пробовала и без него - тоже долго. оно на производительность сильно не влияет.
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542660
VNI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VNI
Гость
Shocker.Pro,

действительно нужно.
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542689
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
VNI,

Ну например я вот так состряпал ан скорую руку:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
Option Explicit

Sub test()
 Dim ch As Range
 Dim c As Range
 Dim firstAddress As String
 
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

 
 With Worksheets( 2 )
   For Each ch In .Range("a1:a10000")
    Set c = Worksheets( 1 ).Range("a1:a50000").Find(ch.Value, LookIn:=xlValues)
      
    If Not c Is Nothing Then
     firstAddress = c.Address
     Do
       c.Offset( 0 ,  1 ).Value = ch.Offset( 0 ,  2 ).Value
       Set c = Worksheets( 1 ).Range("a1:a50000").FindNext(c)
     Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
   Next ch
 End With
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

End Sub

В данном примере предполагается, что на первом листе 50 тысяч строк
а на втором 10 тысяч строк
Можно модифицировать и определите где какое точное количество строк.
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542713
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Оптимизировал код:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
Option Explicit

Sub test()
 Dim ch As Range
 Dim c As Range
 Dim firstAddress As String
 Dim ran1 As Range
 Dim ran2 As Range
 
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

 Set ran1 = Intersect(Worksheets( 1 ).UsedRange, Worksheets( 1 ).Columns( 1 ))
 Set ran2 = Intersect(Worksheets( 2 ).UsedRange, Worksheets( 2 ).Columns( 1 ))
  
 
 For Each ch In ran2
  Set c = ran1.Find(ch.Value, LookIn:=xlValues)
    
  If Not c Is Nothing Then
   firstAddress = c.Address
   Do
     c.Offset( 0 ,  1 ).Value = ch.Offset( 0 ,  2 ).Value
     Set c = ran1.FindNext(c)
   Loop While Not c Is Nothing And c.Address <> firstAddress
  End If
 Next ch
 
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

End Sub
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36542728
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Можно ещё увеличить скорость за счёт того, что значения в первом столбце первого листа уникальны, поэтому достаточно найти лишь один элемент, а не пытаться найти все элементы, т.к. других там быть не должно.
Единственный вопрос ещё остался, что делать с теми элементами, которые есть на втором листе, но нет на первом. Добавить в конец первого листа или такого быть не должно?
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36543678
VNI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VNI
Гость
нет, если не нашли - то не нашли. ничего добавлять не нужно.
Спасибо огромное!!! прогнала на тесте работает. теперь попробую на большом количестве строк. Очень надеюсь, что скорость будет приемлемая.
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36543942
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: VNI
> К сообщению приложен файл (Книга1.xls): cкачать. Размер - 15Kb

На пример данных не похоже. потому что только 5 столбцов, а в коде идут операции и с 18 столбцом. Ну да ладно.
в твоем файле примем что данные на Лист2 это VNIданные одного листа которые нужно дополнит колонкой с соответствующими значениями со второго листа., а Лист1 это данные которыми нужно дополнять. Сверять данные на листах нужно по данным из столбца "Номер".

Закончили с условиями, теперь решение:
1). Копируем столбец "Номер" в столбец "А" на Лист2
2). Переходим на Лист1 и в ячейке F2 пишем формулу: =ВПР(D2;Лист2!$A$2:$E$7;3;ЛОЖЬ)
3). Протягиваем эту формулу по всем строкам. После чего получаем по некоторым ячейкам "имя №", а по некоторым ячейкам #Н/Д.
4). Ставим Автофильтр по всей таблице и по столбцу F выбираем показывать ячейки содержищие #Н/Д
5). Отфильтрованные строки и будут искомыми на добавление. Их нужно скопировать и вставить в Лист2.

Всё. Во вложении иллюстрация этого решения
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36544646
VNI
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VNI
Гость
Игорь,
спасибо! попробую.

По поводу варианта с Find. он ищет так:
если строка "1 10.01.2010", то под совпадение попадут строки "1 10.01.2010", "21 10.01.2010", "12341 10.01.2010". о, как. поищу у find настройки какие-нибудь.
...
Рейтинг: 0 / 0
сопоставление данных на двух листах
    #36544688
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
VNI
если строка "1 10.01.2010", то под совпадение попадут строки "1 10.01.2010", "21 10.01.2010", "12341 10.01.2010". о, как. поищу у find настройки какие-нибудь.Если настройки не найдёшь, то можно после поиска просто сравнивать найденное значение с искомым и если совпадает, то делать нужные действия.Например в моём коде это было бы так:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
Sub test()
 Dim ch As Range
 Dim c As Range
 Dim firstAddress As String
 Dim ran1 As Range
 Dim ran2 As Range
 
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

 Set ran1 = Intersect(Worksheets( 1 ).UsedRange, Worksheets( 1 ).Columns( 1 ))
 Set ran2 = Intersect(Worksheets( 2 ).UsedRange, Worksheets( 2 ).Columns( 1 ))
  
 
 For Each ch In ran2
  Set c = ran1.Find(ch.Value, LookIn:=xlValues)
    
  If Not c Is Nothing Then
   firstAddress = c.Address
   Do
     If c.Value = ch.Value Then
       c.Offset( 0 ,  1 ).Value = ch.Offset( 0 ,  2 ).Value
     End If
     Set c = ran1.FindNext(c)
   Loop While Not c Is Nothing And c.Address <> firstAddress
  End If
 Next ch
 
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

End Sub
...
Рейтинг: 0 / 0
25 сообщений из 45, страница 1 из 2
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / сопоставление данных на двух листах
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]