excel - 计算列中的值并放入新列

Question

我想计算一个值在列家具中出现的次数，但是该列有时可能位于不同的位置。所以我必须引用名称而不是列号。最终创建一个新列，其中说明该家具出现了多少次。下面是一个简单的例子。


所有者
家具


欧文
椅子

米拉
table

将要

jack
椅子

佐伊
灯

麦克风
灯

玛雅
椅子


想要的结果


所有者
家具
分组大小


欧文
椅子
3

米拉
table
1

将要


jack
椅子
3

佐伊
灯
2

麦克风
灯
2

玛雅
椅子
1


“椅子”在柱式家具中出现 3 次
我知道 countif公式，但我需要 vba。我尝试了几件事，但都没有接近。有什么建议么？

Answer 1

使用字典的唯一计数

Option Explicit

Sub CountFurniture()
    
    Const sColName As String = "furniture"
    Const dColName As String = "groupsize"
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    
    Dim sData As Variant
    Dim drg As Range
    Dim rCount As Long
    
    With rg
        
        rCount = .Rows.Count
        If rCount = 1 Then Exit Sub ' only headers or nothing
        
        Dim sCol As Variant: sCol = Application.Match(sColName, .Rows(1), 0)
        If IsError(sCol) Then Exit Sub ' source column not found
        sData = .Columns(sCol).Value
        
        Dim dCol As Variant: dCol = Application.Match(dColName, .Rows(1), 0)
        If IsError(dCol) Then dCol = .Columns.Count + 1
        Set drg = .Columns(dCol)
    
    End With
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
                
    Dim Key As Variant
    Dim r As Long

    For r = 2 To rCount
        Key = sData(r, 1)
        If Not IsError(Key) Then
            If Len(Key) > 0 Then
                dict(Key) = dict(Key) + 1
            End If
        End If
    Next r
    
    Dim dData As Variant: ReDim dData(1 To rCount, 1 To 1)
    
    dData(1, 1) = dColName
    
    For r = 2 To rCount
        dData(r, 1) = dict(sData(r, 1))
    Next r
    
    drg.Value = dData
    
End Sub