找到组合多行excel

时间:2017-05-23 14:18:49

标签: excel vba

我在excel中的数据如下所示:

Ingredient1  Ingredient2  Ingredient3  Ingredient 4
Salami       Tuna         Peperoni     Mushroom
Salami       Peperoni     Mushroom
Salami       Mushroom

成分是列名,有些单元格是空的,因为没有足够的成分。

我想得到组合和计数,例如:

Salami, Tuna      1 
Salami, Peperoni  2
Salami, Mushroom  3

这可能吗?

1 个答案:

答案 0 :(得分:0)

我有点。如果你愿意,你可以试一试。它需要修改您的特定输入和输出,但它的工作原理。它将第一列与每种成分和计数结合起来。即它不会像蘑菇,意大利辣味香肠等组合回归。但这不是你在问题中指定的内容

Option Explicit
Public Sub CountDemo()
    Dim dict As Object
    Dim rng As Range
    Dim c
    Dim Ing As String
    Dim i As Long
    Dim key
    '' Set up for dictionary object
    Set dict = CreateObject("Scripting.Dictionary")
    '' Declare data range
    With Sheet1
        Set rng = .Range(.Cells(2, 2), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 4))
    End With

    '' Loop through each c in range
    For Each c In rng.Cells
        '' Test if cell is null
        If Not c.Value2 = vbNullString Then
            '' Set Ingredient combo to variable
            Ing = c.Offset(0, 1 - c.Column).Value2 & ", " & c.Value2
            '' Test if value exists in dictionary
            If dict.exists(Ing) Then
                '' If exists increase count by 1
                dict(Ing) = dict(Ing) + 1
            Else
                '' If doesn't exist then add to dictionary and set to default value of 1
                dict.Add key:=Ing, Item:=1
            End If
        End If
    Next c

    '' Output results
    'Starting row
    i = 8
    '' Loop through each ingredient combo
    For Each key In dict.keys
        '' Print to sheet values
        With Sheet1.Cells(i, 1)
            .Value2 = key
            .Offset(0, 1).Value2 = dict(key)
        End With
        i = i + 1
    Next key
End Sub