计算数据集中具有高值的对

时间:2018-02-11 18:08:20

标签: excel vba formula

我有一组带有列标题A,B,C,D,E ... K的数据,在单元格中,有0到6之间的值。我正在寻找一种方法来计算和列出具有高值(4,5,6)的对或三元组。

例如,如果A和B列分别在同一行中有5和6,则应在计算事件时对其进行计数。如果它是1和6,1和5等,那么应该跳过它。只有当两个(可以多于2列)在同一行上具有高值时才应计算。

基本上,如果列在同一行中具有高值,我想计算并列出列。我对所有类型的解决方案都持开放态度。如果有人指导我如何做到这一点,我真的很感激。谢谢。

示例输出:

Pairs   Number of Occurrences (can be (5,6), (4,6),(5,5), (4,5), (6,6))         
AB          10          
BC          20          
CE          30      

这是我的数据图片。 这只是我实际数据的一部分。不是完整的清单。对不起,我说0到6之间的值。我删除了0,现在它们都是空白的。

enter image description here

A   B   C   D   E   F   G   H   I   J   K   L   M
3   3   2   4   2   4   5   4   2   2   4   3   3
2   4   3   3   3   3   6   4   2   3   3   2   4
3   3   2   4   2   4   3   3   3   3   3   3   3
3   3   4   2   4   2   4   3   3   5   1   3   3
2   4   4   2   4   2   3   6       4   2   2   4
2   4   2   4   2   4   3   3   3   3   3   2   4
3   3   2   4   2   4   3   3   3   3   3   3   3
5   1   2   4   2   4   3   3   3   3   3   5   1
2   4   1   5   1   5   3   4   2   3   3   2   4
3   3   2   4   2   4   3   3   3   3   3   3   3
5   1   2   4   2   4   2   3   3   3   3   5   1
3   3   2   4   2   4   3   4   2   4   2   3   3
4   2   3   3   3   3   3   3   3   4   2   4   2
3   3   3   3   3   3   3   3   3   6   0   3   3
2   4   3   3   3   3   3   4   2   5   1   2   4
4   2   2   4   2   4   3   1   5   3   3   4   2
2   4   4   2   4   2   4   3   3   3   3   2   4
3   3   2   4   2   4   3   2   4   4   2   3   3
3   3   4   2   4   2   4   3   3   3   3   3   3
4   2   2   4   2   4   3   3   3   3   3   4   2
2   4   3   3   3   3   3   3   3   4   2   2   4
2   4   2   4   2   4   2   2   4   4   2   2   4
4   2   3   3   3   3   5   4   2   1   5   4   2
3   3   3   3   3   3   3   4   2   3   3   3   3
1   5   2   4   2   4   3   4   2   2   4   1   5
5   1   4   2   4   2   6   1   5   3   3   5   1
4   2   1   5   1   5   3   3   3   2   4   4   2
1   5   2   4   2   4   1   3   3   3   3   1   5
2   4   4   2   4   2   1   2   4   2   4   2   4
4   2   5   1   5   1   2   4   2   3   3   4   2
4   2   1   5   1   5   4   1   5   4   2   4   2
2   4   3   3   3   3   3   3   3   6   0   2   4
4   2   2   4   2   4   3   3   3   3   3   4   2

2 个答案:

答案 0 :(得分:2)

我制作了两个帮助列,用于列出列对,然后使用此公式计算(4,5)(4,6)(5,6)的对。

= SUMPRODUCT(COUNTIFS(INDEX($A:$M,0,MATCH(O2,$A$1:$M$1,0)),{4,4,5,5,6,6},
                      INDEX($A:$M,0,MATCH(P2,$A$1:$M$1,0)),{5,6,6,4,4,5}))

编辑 根据您最近的评论,公式更新为:

= COUNTIFS(INDEX($A:$M,0,MATCH(O2,$A$1:$M$1,0)),">3",
           INDEX($A:$M,0,MATCH(P2,$A$1:$M$1,0)),">3"))

请参阅下面的示例,我没有针对每一列进行此操作,但给了它一个良好的开端:

请注意您的原始数据位于我的电子表格左侧,我没有在此处显示,只是为了节省空间。

enter image description here

答案 1 :(得分:2)

这里有一个利用Dictionary的VBA解决方案(需要添加对Microsoft Scripting Runtime库的引用):

Option Explicit

Sub main()
    Dim col As Range
    Dim cell As Range

    Dim pairDict As Scripting.Dictionary

    Set pairDict = New Scripting.Dictionary

    With Worksheets("rates")
        With .Range("a1").CurrentRegion
            For Each col In .Columns.Resize(, .Columns.Count - 1) 'loop through referenced range columns except the last one
                .AutoFilter Field:=col.Column, Criteria1:=">4" 'filter reference range on current column with values > 4
                If Application.WorksheetFunction.Subtotal(103, col) > 1 Then ' if any filtered cells except header
                    For Each cell In Intersect(.Offset(, col.Column).Resize(, .Columns.Count - col.Column), .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow) 'loop through each row of filtered cells from one column right of current one to the last one
                        If cell.Value > 4 Then pairDict(.Cells(1, col.Column).Value & .Cells(1, cell.Column).Value) = pairDict(.Cells(1, col.Column).Value & .Cells(1, cell.Column).Value) + 1 ' if current cell value is >4 then update dictionary with key=combination of columns pair first row content and value=value+1
                    Next
                End If
                .AutoFilter 'remove current filter
            Next
        End With
        .AutoFilterMode = False 'remove filters headers
    End With

    If pairDict.Count > 0 Then ' if any pair found
        Dim key As Variant
        For Each key In pairDict.Keys 'loop through each dictionary key
            Debug.Print key, pairDict(key) 'print the key (i.e. the pair of matching columns first row content) and the value ( i.e. the number of occurrences found)
        Next
    End If
End Sub