День добрый. Дайте пожалуйста подсказку : есть массив: 5 столбцов и 100 строк. Анализ (поиск) построчный! Как найти все повторяющиеся ПАРЫ (или даже тройки) ячеек и, например, раскрасить уникальными цветами(каждый случай - 1 цвет). Последовательность расположения не важна, - т.е. первая пара может быть например в 3 и 5 столбце и такая(-ие) же пара, в другой строке, но в других столбцах. В приложенном файле каждый случай выделен уникальным цветом, а если содержимое ячейки участвует в разных случаях - то цвет рамки совпадает со второй парой. В этом примере (но это из жизни) сложный случай - в разных строчках две тройки чисел совпало. Спасибо. Алексей.
День добрый. Дайте пожалуйста подсказку : есть массив: 5 столбцов и 100 строк. Анализ (поиск) построчный! Как найти все повторяющиеся ПАРЫ (или даже тройки) ячеек и, например, раскрасить уникальными цветами(каждый случай - 1 цвет). Последовательность расположения не важна, - т.е. первая пара может быть например в 3 и 5 столбце и такая(-ие) же пара, в другой строке, но в других столбцах. В приложенном файле каждый случай выделен уникальным цветом, а если содержимое ячейки участвует в разных случаях - то цвет рамки совпадает со второй парой. В этом примере (но это из жизни) сложный случай - в разных строчках две тройки чисел совпало. Спасибо. Алексей.Alex77799
в вашем файле никаких разукрашек не хватит "для сложных случаев" ибо, к примеру, в 17-й строчке имеются четыре разных пары: 18-22, 18-27, 22-27 и 18-39 и одна тройка 18-22-27
предлагаю выводить результаты в отдельный диапазон. в приложенном файле сделано для пар. [vba]
Код
Option Explicit Sub t() Dim a(), d, dd, ddd, dk(), e, i&, j&, s$, n&
a = [a1].CurrentRegion.Value: [h:i].Clear Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(a) For j = 1 To UBound(a, 2) If d.exists(a(i, j)) Then Set dd = d(a(i, j)) Else Set dd = CreateObject("scripting.dictionary") dd(i) = 0&: Set d(a(i, j)) = dd Next j, i
dk = d.keys: Set ddd = CreateObject("scripting.dictionary") For i = LBound(dk) To UBound(dk) - 1 Set dd = d(dk(i)) For j = i + 1 To UBound(dk) s = "": n = 0 For Each e In dd.keys If d(dk(j)).exists(e) Then s = s & "|" & e: n = n + 1 Next If n > 1 Then ddd(dk(i) & "|" & dk(j)) = Mid(s, 2) Next j, i If ddd.Count Then [h1].Resize(ddd.Count, 2).Value = Application.Transpose(Array(ddd.keys, ddd.items)) End Sub
[/vba]
для троек - аналогично.
в вашем файле никаких разукрашек не хватит "для сложных случаев" ибо, к примеру, в 17-й строчке имеются четыре разных пары: 18-22, 18-27, 22-27 и 18-39 и одна тройка 18-22-27
предлагаю выводить результаты в отдельный диапазон. в приложенном файле сделано для пар. [vba]
Код
Option Explicit Sub t() Dim a(), d, dd, ddd, dk(), e, i&, j&, s$, n&
a = [a1].CurrentRegion.Value: [h:i].Clear Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(a) For j = 1 To UBound(a, 2) If d.exists(a(i, j)) Then Set dd = d(a(i, j)) Else Set dd = CreateObject("scripting.dictionary") dd(i) = 0&: Set d(a(i, j)) = dd Next j, i
dk = d.keys: Set ddd = CreateObject("scripting.dictionary") For i = LBound(dk) To UBound(dk) - 1 Set dd = d(dk(i)) For j = i + 1 To UBound(dk) s = "": n = 0 For Each e In dd.keys If d(dk(j)).exists(e) Then s = s & "|" & e: n = n + 1 Next If n > 1 Then ddd(dk(i) & "|" & dk(j)) = Mid(s, 2) Next j, i If ddd.Count Then [h1].Resize(ddd.Count, 2).Value = Application.Transpose(Array(ddd.keys, ddd.items)) End Sub
добавил проверку на тройки и - если уж очень хочется разукрашек - выделение совпадающих позиций цветом для выбранной пары (тройки) - просто щелкайте по ячейкам в столбцах H и I
добавил проверку на тройки и - если уж очень хочется разукрашек - выделение совпадающих позиций цветом для выбранной пары (тройки) - просто щелкайте по ячейкам в столбцах H и Iikki
ikki вот какой момент случился: левая верхняя ячейка массива у меня b2, а выводить рез-т нужно с левой верхней n3. Я a1 поменял на b2 и h1 на n3 в коде, но у меня вокруг массива (вплотную) много других данных - и он при исполнении кромсает мне столбцы h и i и в рез-те выводит 1939 строк (столько не может быть). А эта кнопочка - элемент управления формы?
ikki вот какой момент случился: левая верхняя ячейка массива у меня b2, а выводить рез-т нужно с левой верхней n3. Я a1 поменял на b2 и h1 на n3 в коде, но у меня вокруг массива (вплотную) много других данных - и он при исполнении кромсает мне столбцы h и i и в рез-те выводит 1939 строк (столько не может быть). А эта кнопочка - элемент управления формы?Alex77799
Сообщение отредактировал Alex77799 - Пятница, 15.08.2014, 15:53
Какая задача стоит - просто красиво разукрасить или как-то вычленить пары (тройки)?
Как вариант - полуручной метод вычленения: 1. Формируем сочетания пар и троек ячеек для каждой строки 2. Макросом-редизайнером разбиваем получившуюся таблицу на один столбец с парами (тройками) 3. Формируем сводную 4. Отключаем фильтром отображение единиц, факультативно - сортируем по убыванию
В приложенном примере сделано для пар.
Какая задача стоит - просто красиво разукрасить или как-то вычленить пары (тройки)?
Как вариант - полуручной метод вычленения: 1. Формируем сочетания пар и троек ячеек для каждой строки 2. Макросом-редизайнером разбиваем получившуюся таблицу на один столбец с парами (тройками) 3. Формируем сводную 4. Отключаем фильтром отображение единиц, факультативно - сортируем по убыванию
ikki .... это собственно кнопка старт, запуск макроса. И обнаружил ошибку: в выводе рез-та все строки ошибаются на 1 - короче, если искомая комбинация в 60 строке, - то он пишет, что она в 59. Если Вам не трудно..
ikki .... это собственно кнопка старт, запуск макроса. И обнаружил ошибку: в выводе рез-та все строки ошибаются на 1 - короче, если искомая комбинация в 60 строке, - то он пишет, что она в 59. Если Вам не трудно..Alex77799