Excel VBA基于分组生成报表 [英] Excel VBA Generating report based on grouping

问题描述

我有一个我创建的Excel VBA。它基于输入文件生成输出。

在该文件中，有一个包含用户名的字段，这些用户名在整个列中重复。

我需要做的是，将用户名分配给独立的单元格，不重复，然后计算重复的单元格。

解决方案

假设我有我的excel工作表设置如下：

1. 列A中的用户名列表


2. 在列BI中，所有唯一的用户名



3. 在列中，需要计算每个名称中有多少个

    用户名唯一计数
    1 John John 1 
    2 Susan Susan 2 
    3 Chris Chris 3 
    4 Susan 
    5 Chris 
    6 Chris 
     

我可以在VBA中将用户名放入一个字典，其中 Key 是用户名， Value 是重复次数。我然后只是迭代字典以获得所需的输出。

此代码适用于我：

  Sub UserNameCount（）
 Dim usernames As Range，name As Range，rw As Long 
 
 Set dict = CreateObject（Scripting.Dictionary）
设置用户名=范围（A2：A& Range（A1）。End（xlDown）.Row）
 rw = 2 
 
对于每个用户在用户名
如果不是dict.Exists（user.Value）然后
 dict.Add user.Value，1 
 Else 
 dict.Item（user.Value）= dict.Item（user.Value） + 1 
结束如果
下一个用户
 
对于每个v在dict.Keys 
范围（B& rw）= v 
范围C& rw）= dict.Item（v）
 rw = rw + 1 
下一个
 
设置dict = Nothing 
 End Sub 
注意：您可能需要执行工具>参考>Microsoft脚本运行时以使字典正常工作 

I have an Excel VBA that I created. It generates an output based on an input file.

In that file, there is a field that contains usernames, these usernames are repeated throughout the column.

What I need to do is, assign the usernames to separate cells to be unique not repeated, and then count the repeated ones.

解决方案

Suppose I have my excel worksheet setup as follows:

1. List of usernames in column A
2. In column B I want all unique usernames

3. In column C I want a count of how many of each name there are

       Username     Unique     Count
   1   John         John       1
   2   Susan        Susan      2
   3   Chris        Chris      3
   4   Susan
   5   Chris
   6   Chris
   

I can do this in VBA by putting the usernames into a dictionary where the Key is the username and the Value is the number of repetitions. I then just iterate over the dictionary to get the desired output.

This code worked for me:

Sub UserNameCount()
    Dim usernames As Range, name As Range, rw As Long

    Set dict = CreateObject("Scripting.Dictionary")
    Set usernames = Range("A2:A" & Range("A1").End(xlDown).Row)
    rw = 2

    For Each user In usernames
        If Not dict.Exists(user.Value) Then
            dict.Add user.Value, 1
        Else
            dict.Item(user.Value) = dict.Item(user.Value) + 1
        End If
    Next user

    For Each v In dict.Keys
        Range("B" & rw) = v
        Range("C" & rw) = dict.Item(v)
        rw = rw + 1
    Next

    Set dict = Nothing
End Sub

NB: you may need to do Tools > References > Microsoft Scripting Runtime to get the dictionary to work

这篇关于Excel VBA基于分组生成报表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！