Нахождение количества совпадений - PullRequest
1 голос
/ 23 мая 2019

Привет, у меня есть 2 колонки (города и участники) с 5 уникальными городами и 100 000 участников. Некоторые участники могут быть назначены на несколько городов. Мне нужен график с 6 столбцами и 6 строками городов (с дополнительным столбцом без назначенных городов). Значения в таблице будут подсчетами членов. Так что я в основном пытаюсь сосчитать наложение. Как мне это сделать?

Хотелось бы, чтобы это было так же просто, как перетаскивание поля моих городов в столбцы и строки в сводной таблице, но я не могу.

Я бы хотел, чтобы это выглядело так:

Ответы [ 2 ]

0 голосов
/ 25 мая 2019

Вот решение VBA. Установите рабочий массив с одной строкой для каждого отдельного члена, один столбец для каждого отдельного города и заполните 1, где совпадают элемент и город. Затем перенести в выходной массив, где для пар столбцов в рабочем массиве установлено значение 1:

Option Explicit

Sub MultResponse()
Dim LastRow, LastColumn As Long
Dim sht1, sht2 As Worksheet
Dim workArray() As Integer
Dim cityDict As New Scripting.Dictionary
Dim memberDict As New Scripting.Dictionary
Dim city, member As String
Dim item As Integer
Dim i, j As Long
Dim memberNo As Long
Dim cityNo As Integer
Dim outputArray() As Integer
Dim outrow, outcol, rowTotal As Integer

Set sht1 = ThisWorkbook.Worksheets("Sheet1")
Set sht2 = ThisWorkbook.Worksheets("Sheet2")

LastRow = sht1.Cells(sht1.Rows.Count, "A").End(xlUp).Row



' Make list of distinct cities

j = 0
For i = 2 To LastRow
    city = sht1.Cells(i, 2)

    If city <> "" And Not cityDict.Exists(city) Then
        j = j + 1
        cityDict.Add Key:=city, item:=j
    End If

Next i


' Make list of distinct members

j = 0
For i = 2 To LastRow
    member = sht1.Cells(i, 1)
    If member <> "" And Not memberDict.Exists(member) Then
        j = j + 1
        memberDict.Add Key:=member, item:=j
    End If
Next i


' Set up and fill array with one row for each distinct member, one column for each distinct city


ReDim workArray(1 To memberDict.Count, 0 To cityDict.Count)


For i = 2 To LastRow
    member = sht1.Cells(i, 1)
    city = sht1.Cells(i, 2)

    If city <> "" And member <> "" Then
        memberNo = memberDict(member)
        cityNo = cityDict(city)
        workArray(memberNo, cityNo) = 1
    End If
Next i



' Fill output array where pairs of columns in work array are set to 1
' outputArray(0,0) is used for members with missing city


ReDim outputArray(0 To cityDict.Count, 0 To cityDict.Count)

'First do ones with no affiliation

For i = 1 To memberDict.Count
    rowTotal = 0
    For j = 1 To cityDict.Count
        rowTotal = rowTotal + workArray(i, j)
    Next j
    If rowTotal = 0 Then outputArray(0, 0) = outputArray(0, 0) + 1
Next i

' Then do ones with affiliation

For outrow = 1 To cityDict.Count
    For outcol = 1 To cityDict.Count
        For i = 1 To memberDict.Count
            If workArray(i, outrow) = 1 And workArray(i, outcol) = 1 _
                Then outputArray(outrow, outcol) = outputArray(outrow, outcol) + 1
        Next i
    Next outcol
Next outrow

' Transfer output array into sheet

For i = 0 To cityDict.Count
    For j = 0 To cityDict.Count
        sht2.Cells(i + 2, j + 2) = outputArray(i, j)
    Next j
Next i

'Insert row and column headers

sht2.Cells(1, 2) = "N/C"
sht2.Cells(2, 1) = "N/C"

For i = 0 To cityDict.Count - 1
    sht2.Cells(i + 3, 1) = cityDict.Keys(i)
Next i

For j = 0 To cityDict.Count - 1
    sht2.Cells(1, j + 3) = cityDict.Keys(j)
Next j


End Sub

Данные испытаний

enter image description here

Результаты

enter image description here

0 голосов
/ 23 мая 2019

Предполагается, что вы хотите условное форматирование:

Выберите полный диапазон, к которому вы хотите применить форматирование. Затем примените правило (опция формулы), чтобы =B$1=$A2 (при условии, что вы выбрали от B2 до некоторого конца). Использование фиксированного ("$") условия для столбца или строки помогает определить, что это относится к каждой ячейке в выбранном диапазоне по отдельности.

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...