Блог

Я пытаюсь собрать данные из проекта с 12 рабочими листами (по 1 на каждый месяц) примерно с 1000 строками ежемесячно. В каждой строке есть как столбец с объявлением, так и столбец с продаваемой фирмой. Я хочу отфильтровать оба столбца для каждой уникальной строки и в итоге получить список / строку для каждой компании с подсчетом того, сколько раз они были перечислены. Затем эти строки были отсортированы по убыванию чисел. ie:

 CENTURY         15
CENTRAL          4
CIR              4
PROFESSIONALS   3 etc.
SUTTON          3
HOUSE           1
URBAN           1
  

 Listing Firm 1      Selling Firm 1 Name
CENTURY             CIR 
MOUNTAINVIEW        CENTURY 
CENTRAL             CENTURY 
CIR                 SUTTON  
CENTRAL             CENTRAL
PLINTZ              DIRECT
CENTURY             CIR 
CENTURY             CENTURY
DIRECT              CENTURY 
SUTTON              CIR
CENTURY             HOUSE
CENTURY             PROFESSIONALS
REALTY              CENTURY 
CENTRAL             CENTURY 
WALLER              HOUSE
PROFESSIONALS       CENTURY
PROFESSIONALS       CENTURY 
CENTURY             URBAN
CENTURY            SUTTON 
  

Я думаю, что мне нужно сделать это на VBA. Не уверен, так это или нет.:
Могу ли я каким-то образом объединить 2 столбца в один массив
затем выполните цикл по массиву в поисках уникальных строк.
и присвоить этот массив переменной (хотя не уверен, как использовать его для следующего шага). Мне все еще нужно просмотреть исходные 2000 или около того записей (column1 и column2) и подсчитать, сколько было у каждой фирмы.
Я надеюсь, что это имеет смысл для кого-то. Я пытаюсь организовать их в меру своих возможностей, которые ограничены.
Я надеюсь на некоторые указания, верна ли моя логика, и если да, то с чего начать.
Спасибо. geddeca

Словарь может предоставить вам уникальный список и подсчитать одновременно. Как только информация будет возвращена на рабочий лист, можно выполнить быструю сортировку.

Следующее собирает и обрабатывает информацию с одного листа. Должно быть относительно легко перебрать дюжину листов и обработать каждый.

• собирайте значения с листа
• обработайте словарь списка и подсчета
• верните новые значения на рабочий лист
• сортируйте значения по убыванию количества, затем по возрастанию имени

Код:

 Option Explicit

Sub macro()

    Dim i As Long, j As Long, w As Long
    Dim arr As Variant, dict As Object

    Set dict = CreateObject("scripting.dictionary")
    dict.comparemode = vbTextCompare

    For w = 1 To 1
        With Worksheets(w)

            'collect values from worksheet
            arr = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "B").End(xlUp)).Value2

            'process dictionary of list and count
            dict.RemoveAll
            For i = LBound(arr, 1) To UBound(arr, 1)
                For j = LBound(arr, 2) To UBound(arr, 2)
                    dict.Item(arr(i, j)) = dict.Item(arr(i, j))   1
                Next j
            Next i

            'return new values to worksheet
            .Cells(1, "D").Resize(1, 2) = Array("list", "count")
            .Cells(2, "D").Resize(dict.Count, 1) = Application.Transpose(dict.keys)
            .Cells(2, "E").Resize(dict.Count, 1) = Application.Transpose(dict.items)

            'sort values by count descending then name ascending
            With .Range(.Cells(1, "D"), .Cells(.Rows.Count, "E").End(xlUp))
                .Sort key1:=.Columns(2), order1:=xlDescending, _
                      key2:=.Columns(1), order2:=xlAscending, _
                      Header:=xlYes
            End With

        End With
    Next w

End Sub