如何在Excel中根据数量生成抽奖名单

需求背景

公司会经常筹办一些内促赛,目的是激励销售去创造更多流水.抽奖是常用的以小博大的手段,例如下面方案

在2020年双十一期间,即11月1日-11日24点,销售每成交1单,即获得一份抽奖券.在双十一结束之后,也就是11月12日,将进行iPhone12的抽奖活动,届时,抽奖券的数量将会决定销售的中奖概率

例如公司有3个销售小红,小明,小张.他们期间成交的单数及抽奖概率如下表

姓名	成单数	中奖概率
小红	50	50%
小明	30	30%
小张	20	20%

我们在做模型的时候,一般是从数据库取数,会形成一张汇总表

部门	组别	姓名	员工工号	成单数	抽奖券数
销售部	一组	小红	1	50	50
销售部	二组	小明	2	30	30
销售部	三组	小张	3	20	20

但是在抽奖的时候,我们得每一张抽奖券生成一条记录数.因为抽奖系统比较bug,只能按照行数进行抽奖,所以我们要生成员工姓名*成单数这么多行数的记录,也就是100行数据.下面用两种方法在不脱离Excel环境的情况下实现

PowerQuery实现

Step 1 将表加载到PowerQuery

点击数据表,然后依次点击数据–>从表格,将数据加载到PowerQuery

Step 2 在PowerQuery添加自定义列

依次点击添加列–>自定义列,在自定义列公式输入下面内容然后确定

={1..[抽奖券数]}

结果会增加一列

Step 3 点击箭头,扩展到新行,完成

点击字段名右边的双向箭头,选择扩展到新行

然后结果就出来啦

点击主页–>关闭并上载就可以显示到Excel工作表中了

VBA实现

实现逻辑

VBA的实现逻辑是这样的

VBA代码

实现代码如下,为了方便扩展,便将代码极可能的变量化

Sub repeatRow()
    Dim Arr
    Dim i%, j%, k%, wRow%
    Dim Sht As Worksheet,OriSht as Worksheet
    Dim t!
    
    Const ORINAME$ = "数据源"       '数据源所在表名
    Const SHTNAME$ = "抽奖名单"		'要生成抽奖名单的表名
    Const LASTCOL As Byte = 10	    '抽奖券数所在的列数,可以使用`=COLUMN()`查看列号,也可以更改R1C1样式查看
    Const STARTROW As Byte = 2      '第一行数据所在的行号,从标题开始.所以也是标题所在行号
    
    t = Timer	'计时器
    set OriSht = Sheets(ORINAME)
    
    '将数据源写入内存
    With OriSht
        Arr = .Range(.Cells(STARTROW, 1), .Cells(.Cells(.Rows.Count, 1).End(3).Row, LASTCOL))
    End With
    
    '预处理:如果出现同名文件会报错,所以要先删除
    Application.DisplayAlerts = 0
    For Each Sht In Worksheets
        If Sht.Name = SHTNAME Then
            Sht.Delete
            Exit For
        End If
    Next
    Application.DisplayAlerts = 1

    '新建表,并将表名修改为指定名称
    Set Sht = Worksheets.Add(after:=OriSht)
    Sht.Name = SHTNAME
    
    With Sht
        '第一行写标题
        wRow = 1
        For j = LBound(Arr, 2) To UBound(Arr, 2)
            .Cells(wRow, j).Value = Arr(wRow, j)
        Next

        '第二行开始写内容
        wRow = 2
        For i = LBound(Arr) + 1 To UBound(Arr)
            If Arr(i, 1) <> "汇总" Then         '判断第一列是否是汇总两字,来判断是否有汇总行
                For k = 1 To Arr(i, LASTCOL)
                    For j = LBound(Arr, 2) To UBound(Arr, 2)
                        .Cells(wRow, j).Value = Arr(i, j)
                    Next
                    wRow = wRow + 1
                Next
            End If
        Next
    End With
    MsgBox "耗时:" & Format(Timer - t, "0.0s"), vbInformation, SHTNAME & "生成完成"
End Sub

附录

不知道如何运行VBA代码?参照下面这篇文章

如何运行一个宏