Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.67/3: Рейтинг темы: голосов - 3, средняя оценка - 4.67
ZatX
3 / 3 / 1
Регистрация: 15.05.2017
Сообщений: 48
1

Отбор уникальных данных из двух диапазонов

02.07.2017, 11:57. Просмотров 602. Ответов 11
Метки нет (Все метки)

Доброе времени суток, Господа! Помогите мне автоматизировать свод базы данных, для месячной инвентаризации.Приложил маленький пример. В примере на листе "База" Я отметил цветами(оранжевым, и красным) те позиции, которые не сходятся в количестве, а серым цветом, те ,которые отсутствуют в противоположных списках. И вывести уникальные данные на лист "Результат"( "Наименование" в алгоритме сравнении не участвует, так-как важности этот столбец не несёт) на листе"База" может быть до 15 000 строк в двух списках.
0
Вложения
Тип файла: xls Сравнение.xls (31.5 Кб, 2 просмотров)
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
02.07.2017, 11:57
Ответы с готовыми решениями:

Макрос для проверки двух диапазонов данных
Здравствуйте, уважаемые форумчане! Я недавно начал изучать VBA и столкнулся с такой задачкой: ...

Сравнение двух диапазонов на несовпадение
Подскажите пожалуйста, как организовать поиск на несовпадение? На первом листе таблицу надо...

Сравнение двух диапазонов по последней строке
Здравствуйте, Проблема такова. Необходимо сравнить значения в последних строках двух диапазонов,...

Сравнение двух диапазонов ячеек на совпадение
Здравствуйте! Подскажите пожалуйста... Имеется 2 диапазона ячеек А1:A3 и C1:C3, в которых забиты...

Исправить ошибку в коде сравнения двух диапазонов
Не подскажите как исправить. Макрос сравнивает 2 диапазона, и когда находит сходство, из соседней с...

11
ZatX
3 / 3 / 1
Регистрация: 15.05.2017
Сообщений: 48
02.07.2017, 12:47  [ТС] 2
Прошу прощения. Вот более корректный файл:
0
Вложения
Тип файла: xls Сравнение.xls (31.5 Кб, 13 просмотров)
snipe
3165 / 1131 / 276
Регистрация: 07.08.2013
Сообщений: 2,877
03.07.2017, 04:46 3
ZatX,
есть сложность в составлении алгоритма
и она заключается в следующем
некоторые строки не возможно однозначно идентифицировать
например
3023.2007.3 VISION сталь" Рамка 1-на
строк с таким названием и номером целых 3 штуки
и как программе объяснить с какой из этих трех строк работать
может при выгрузке есть еще что-то что позволит сделать строку уникальной - например дата время или есть сразу уникальный номер записи
0
OLEGOFF
994 / 456 / 115
Регистрация: 27.02.2013
Сообщений: 1,323
03.07.2017, 06:31 4
ZatX, попробуйте работу теста.
Visual Basic
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
34
35
36
37
38
39
Sub test()
  Dim ws As Worksheet, a, g, f, dict As Object, aLR&, gLR&, i&
  On Error Resume Next
  
  Set ws = ThisWorkbook.Worksheets("База")
  
  aLR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
  gLR = ws.Cells(ws.Rows.Count, 7).End(xlUp).Row
  a = ws.Range(ws.[a2], ws.Cells(aLR, 3)).Value
  g = ws.Range(ws.[g2], ws.Cells(gLR, 9)).Value
  ReDim f(1 To gLR - 1, 1 To 1)
  
  Set dict = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(a, 1)
    dict.Add a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3), ""
  Next
  For i = 1 To UBound(g, 1)
    If Not dict.exists(g(i, 1) & "|" & g(i, 2) & "|" & g(i, 3)) Then f(i, 1) = 1
  Next
  
  ws.Range(ws.[f2], ws.Cells(gLR, 6)).Value = f
  
  
  aLR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
  gLR = ws.Cells(ws.Rows.Count, 7).End(xlUp).Row
  a = ws.Range(ws.[a2], ws.Cells(aLR, 3)).Value
  g = ws.Range(ws.[g2], ws.Cells(gLR, 9)).Value
  ReDim f(1 To gLR - 1, 1 To 1)
  
  Set dict = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(g, 1)
    dict.Add g(i, 1) & "|" & g(i, 2) & "|" & g(i, 3), ""
  Next
  For i = 1 To UBound(a, 1)
    If Not dict.exists(a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)) Then f(i, 1) = 1
  Next
  
  ws.Range(ws.[d2], ws.Cells(gLR, 4)).Value = f
End Sub
Отмечает нужные строки единичками.Осталось только помеченные строки перенести на другой лист.
Проверьте правильность выбора строк.

Не по теме:

На бОльшее ума не хватает

1
03.07.2017, 06:31
ZatX
3 / 3 / 1
Регистрация: 15.05.2017
Сообщений: 48
03.07.2017, 22:15  [ТС] 5
OLEGOFF, Отлично! Отмечает нужные проблемные строки) А как перенести?

Добавлено через 12 часов 8 минут

Добавлено через 3 минуты
snipe, Ну эт исправимо, макросом сцепления одинаковых значений в столбце... Главное, решить эту задачу
0
OLEGOFF
994 / 456 / 115
Регистрация: 27.02.2013
Сообщений: 1,323
03.07.2017, 22:15 6
Цитата Сообщение от OLEGOFF Посмотреть сообщение
На бОльшее ума не хватает
буду думать,но не гарантирую

Не по теме:

самому интересно

1
Heroes
1 / 1 / 0
Регистрация: 12.06.2015
Сообщений: 93
04.07.2017, 08:38 7
Цитата Сообщение от OLEGOFF Посмотреть сообщение
ZatX, попробуйте работу теста.


Отмечает нужные строки единичками.Осталось только помеченные строки перенести на другой лист.
Как вариант скопировать диапазон по фильтру колонки с еденичками
0
OLEGOFF
994 / 456 / 115
Регистрация: 27.02.2013
Сообщений: 1,323
04.07.2017, 14:36 8
ZatX, второй макрос переносит отмеченные "1" строки в соответствующие таблицы на второй лист и стирает метки "1" на первом.
Не стал объединять два макроса вместе для того,что бы можно было предварительно посмотреть отмеченные первым макросом строки.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub perenos()
Dim i&
Sheets("База").Select
Application.ScreenUpdating = False
For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 4) = 1 Then
Range(Cells(i, 1), Cells(i, 3)).Copy
Sheets("Результат").Cells(Sheets("Результат").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial
End If
Next
Sheets("База").Select
For i = 3 To Cells(Rows.Count, 7).End(xlUp).Row
If Cells(i, 6) = 1 Then
Range(Cells(i, 7), Cells(i, 9)).Copy
Sheets("Результат").Cells(Sheets("Результат").Cells(Rows.Count, 6).End(xlUp).Row + 1, 6).PasteSpecial
End If
Next
Sheets("База").Columns("D:F").ClearContents
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
1
ZatX
3 / 3 / 1
Регистрация: 15.05.2017
Сообщений: 48
06.07.2017, 19:04  [ТС] 9
OLEGOFF, вроде бы всё работает) Спасибо большое и +1 Вам к карме)

Добавлено через 23 часа 53 минуты
OLEGOFF, я извиняюсь. Подскажите пожалуйста, прикрепил макрос "perenos" на кнопку, и он подглючивает (не переносит все значения) и также себя ведёт через Call perenos с первого макроса( как это можно исправить?
0
OLEGOFF
994 / 456 / 115
Регистрация: 27.02.2013
Сообщений: 1,323
06.07.2017, 20:05 10
ZatX, прикрепляйте проблемный файл.
У меня вроде проблем нет.
Цитата Сообщение от snipe Посмотреть сообщение
некоторые строки не возможно однозначно идентифицировать
Возможно в этом проблема
1
Вложения
Тип файла: xls Сравнение.xls (54.0 Кб, 6 просмотров)
OLEGOFF
06.07.2017, 20:05
  #11

Не по теме:

глючит загрузка повторно

0
ZatX
3 / 3 / 1
Регистрация: 15.05.2017
Сообщений: 48
06.07.2017, 22:09  [ТС] 12
OLEGOFF, И с Вашим файлом тоже самое, только две строчки выводит с кнопки( Я думаю... может несовместимость Офиса играет роль!?(у меня 2013) Так-как макрос рабочий, если его запускать на прямую из модуля, так всё чётко работает.
0
06.07.2017, 22:09
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
06.07.2017, 22:09

Макрос для вставки значений из двух именованных диапазонов
Доброго времени суток! Помогите пожалуйста вот с каким вопросом полному лошарику в макросах. ...

Сравнение двух диапазонов и вывод различий на другой лист
Добрый день уважаемые форумчане! Нашёл в инете такой вот код: Option Explicit Sub...

Сравнение двух диапазонов на идентичность без анализа отдельных ячеек
Здравствуйте! Подскажите, как сравнить два диапазона на результат ЛОЖЬ или ИСТИНА (в коде 10-я...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
12
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.