Страницы: 1
RSS
Всевозможные пересечения значений из двух столбцов, Графы двух столбцов с данными
 
Добрый день!

Подскажите, пожалуйста, как можно осуществить с помощью формул или VBA обозначение/нумерацию графов (или их вывод на отдельный лист со всеми элементами).

Имеется два столбца А и B. В них содержатся различные значения, если такие значения находятся в одной строке, то они образуют пару. Значения могут повторяться в нескольких строках и в обоих столбца и образовывать пару с другими значениями (и наоборот, могут встречаться всего лишь раз). В столбце C всем парам, которые связаны между собой через какое-либо общее значение, присваивается общий (одинаковый) номер (1, 2 и т.д.).


Сейчас осуществляю данное действие с помощью фильтрации любого из значений и копирования всех связанных с ним значений, далее с помощью СЧЁТЕСЛИ проверяю какие значения не попали в поле зрения при первом рассмотрении и далее повторяю алгоритм с фильтрацией и добавлением новых обнаруженных элементов, и далее возможны несколько итераций, пока все возможные значения не попадут в один граф.
 
Что-то у меня не сошлось на
Роналду Кокто
Ликер Роналду
Ликер Кокто
это новая группа.
И соотв. далее сбивается...
 
Цитата
написал:
Что-то у меня не сошлось на
да, извините. 3 группа была у меня очень большой - я ее сократил. Из-за этого некоторые пары отвалились. А результат не откорректировал. Вы правы, в данном варианте это будет группа из 3 упомянутых элементов.

Откорректировал пример, добавил в конец еще одну пару.
Изменено: Сироп Клубничный - 19.06.2024 12:49:29
 
Как-то коряво но сошлось, впервые такое делал, наверняка есть готовые наработки у кого-то...
Черновик, тут жёстко привязан к диапазону примера, результат пишет правее чтоб можно было сравнить:
Код
Sub tt()
Dim a, c, i&, ii&, x&, z&

z = 1
With CreateObject("Scripting.Dictionary")
.Item([a4].Value) = 1
a = [a4:b182].Value
For i = 1 To UBound(a)
For ii = i + 1 To UBound(a)
If .exists(a(ii, 1)) Or .exists(a(ii, 2)) Then
x = Application.Max(.Item(a(ii, 1)), .Item(a(ii, 2)))
.Item(a(ii, 1)) = x
.Item(a(ii, 2)) = x
End If
Next

If Not .exists(a(i, 1)) And Not .exists(a(i, 2)) Then
z = z + 1
.Item(a(i, 1)) = z
.Item(a(i, 2)) = z
End If
Next
For Each c In [a4:a182]
c.Next.Next.Next.Value = .Item(c.Value)
Next
End With

End Sub
 
И кстати если нужно - в самом конце кода можно перебрать словарь и вывести список всех ключей с номерами групп.
 
Я так понял, цель - заполнить колонку Результат на листе "Для анализа"?
Сделал формулами через 2 доп. столбца.
 
Hugo, спасибо огромное! Макрос отлично сработал. Подскажите, пожалуйста, с выводом ключей.


andypetr, спасибо за помощь! На большем количестве данных результаты отличаются от истинных. Моя догадка, что, возможно, из-за ограничения в 255 символов в одной ячейке.
Изменено: Сироп Клубничный - 19.06.2024 16:09:54
 
Цитата
Сироп Клубничный написал:
Подскажите, пожалуйста, с выводом ключей.
- дописал
Скрытый текст
 
Hugo, еще раз спасибо Вам! Благодарю за помощь.
 
Цитата
На большем количестве данных результаты отличаются от истинных.
  1. Возможно из-за того, что я написал ограничение в 999 строк (ссылки в формуле вида D5:D$999) - поменял на 999999 (см. файл).
  2. Ещё, т.к. у меня в формуле Индекс накапливаются узлы одного графа (в одной ячейке), то может сработать ограничение на размер текста в ячейке: 32767 символов, т.е. примерно 3000 узлов (=строк с одинаковым номером Результат), считая в среднем наименование по 10 символов.
Страницы: 1
Наверх