Последние записи

made in programmersforum 4

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

11th
Ноя

Как определить общие элементы множества строк (Excel)

Posted by obzor under VBA

Имеется база данных в excel из двух столбцов. 1й — номер строки, 2ой — содержит 30 чисел от 1 до 90. Числа в строке не повторяются.

Как определить какие 3,4,5,6… числа совпадают в максимальном количестве строк?

Hugo121

Код:


Sub Perebor() 'коллекция в словаре
    Dim a, i&, t$, Dic As Object
    Dim el, col, mx&, mxs$
    
    a = Range("B1", Cells(Rows.Count, "B").End(xlUp)).Value
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        .CompareMode = 1
        For i = 1 To UBound(a)
        For Each el In Split(a(i, 1))
            t = el
            If Not .exists(t) Then .Add t, New Collection
            .Item(t).Add i
        Next
        Next
    End With
    
    For Each el In Dic.keys
        Select Case True
        Case mx < Dic.Item(el).Count
        mx = Dic.Item(el).Count
        mxs = ", " & el
        Case mx = Dic.Item(el).Count
        mxs = mxs & ", " & el
        End Select
    Next

MsgBox "В " & mx & " строках есть числа " & Mid(mxs, 3)
End Sub

Промежуточный вариант — вывод в окно отладки.
Можно всё это загрузить в массив (или например на лист), отсортировать по убыванию, взять сколько нужно первых строк.

Код:


Sub Perebor2() 'коллекция в словаре
    Dim a, i&, t$, Dic As Object, Dic2 As Object
    Dim el, col, mx&, mxs$
    
    a = Range("B1", Cells(Rows.Count, "B").End(xlUp)).Value
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        .CompareMode = 1
        For i = 1 To UBound(a)
        For Each el In Split(a(i, 1))
            t = el
            If Not .exists(t) Then .Add t, New Collection
            .Item(t).Add i
        Next
        Next
    End With
    
    Set Dic2 = CreateObject("Scripting.Dictionary")
    For Each el In Dic.keys
        Dic2.Item(Dic.Item(el).Count) = Dic2.Item(Dic.Item(el).Count) & ", " & el
    Next

    For Each el In Dic2.keys
      Debug.Print "В " & el & " строках есть числа " & Mid(Dic2.Item(el), 3)
    Next

End Sub

тема на форуме

Последние записи

made in programmersforum 4

Как определить общие элементы множества строк (Excel)

Похожие статьи

Купить рекламу на сайте за 1000 руб

пишите сюда - alarforum@yandex.ru