Адаптируйте код VBA, чтобы выбрать уникальные заголовки сводной таблицы, если условие выполнено

Question

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

Пример: у меня есть заголовки сводных столбцов с 10 странами и 10 людьми в строках. Если Джон продавал товары по значению X только в Великобритании и США, я хочу перечислить страны в одной ячейке «Великобритания, США» рядом с Джоном по формуле.

То же самое для Салли, и так далее ..

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

Проблема 1: Насколько я понимаю, в настоящее время он настроен на работу с двоичными значениями. Учитывая, что мне нужно получить абсолютную стоимость в долларах, мое единственное условие должно быть "> 0".

Проблема 2: Как работает синтаксис этой формулы? ValueSearch (простой диапазон столбцов с данными, соответствующий диапазон строк) -> но это не работает

Можете ли вы помочь мне сделать этот тик?

Function ValueSearch(DataArea As Range, Optional ByVal FunctionType As Long) As Variant

Dim ws As Worksheet
Dim cl As Range
Dim cUnique As New Collection
Dim cValue As Variant

With Application
    .Volatile (False)
End With

Set ws = DataArea.Parent

If DataArea.Columns.Count > 1 Then
    ValueSearch = CVErr(xlErrValue)
    GoTo errorplace2
End If

If FunctionType <> 1 And FunctionType <> 0 Then
    ValueSearch = CVErr(xlErrValue)
    GoTo errorplace2
End If

searchROW = DataArea.Row
searchCOLUMN = DataArea.Column

With ws
    If .Cells(1, searchCOLUMN).Value <> "" Then
        fr = 1
    Else
        fr = .Cells(1, searchCOLUMN).End(xlDown).Row
    End If

    lr = .Cells(Rows.Count, searchCOLUMN).End(xlUp).Row

    If lr = 1 Then
        Set DataArea = .Cells(searchROW, searchCOLUMN)
    Else
        Set DataArea = .Range(.Cells(fr, searchCOLUMN), _
        .Cells(lr, searchCOLUMN + DataArea.Columns.Count - 1))
    End If
End With

On Error Resume Next

For Each cl In DataArea
    If cl.Formula <> "" Then
        cUnique.Add cl.Value, CStr(cl.Value)
    End If
Next cl

ValueSearch = ""
IterationNumber = 1000
LimitCellValue = 32767

If FunctionType = 1 Then
    ValueSearch = cUnique.Count
ElseIf FunctionType = 0 Then
    If cUnique.Count > IterationNumber Then
        ccount = IterationNumber
    Else
        ccount = cUnique.Count
    End If
    For i = 1 To ccount
        If ValueSearch = "" Then
            ValueSearch = ValueSearch & cUnique(i)
        ElseIf ValueSearch <> "" Then
            ValueSearch = ValueSearch & "," & cUnique(i)
        End If
    Next
End If

If ValueSearch = "" Then
    ValueSearch = CVErr(xlErrNA)
    GoTo errorplace2
End If

If Len(ValueSearch) > LimitCellValue Then
    ValueSearch = Left(ValueSearch, LimitCellValue)
End If

If Right(ValueSearch, 1) = "," Then
    ValueSearch = Left(ValueSearch, Len(ValueSearch) - 1)
End If

On Error GoTo errorplace2

devamfunc2:

Exit Function

errorplace2:

Set cUnique = Nothing

GoTo devamfunc2

End Function