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

清疚 2022-11-21 11:57 183阅读 0赞

### 文章目录 ###

*  需求背景
 *  PowerQuery实现
 *   *  Step 1 将表加载到PowerQuery
     *  Step 2 在PowerQuery添加自定义列
     *  Step 3 点击箭头,扩展到新行,完成
 *  VBA实现
 *   *  实现逻辑
     *  VBA代码
 *  附录

# 需求背景 #

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

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

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

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

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

# PowerQuery实现 #

## Step 1 将表加载到PowerQuery ##

点击数据表,然后依次点击数据–>从表格,将数据加载到`PowerQuery`  
![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3NpbmF0XzQxODcwMTQ4_size_16_color_FFFFFF_t_70_pic_center]

## Step 2 在PowerQuery添加自定义列 ##

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

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

![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3NpbmF0XzQxODcwMTQ4_size_16_color_FFFFFF_t_70_pic_center 1]  
结果会增加一列  
![在这里插入图片描述][20201101212304690.png_pic_center]

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

点击字段名右边的双向箭头,选择`扩展到新行`  
![在这里插入图片描述][20201101212428122.png_pic_center]  
然后结果就出来啦  
![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3NpbmF0XzQxODcwMTQ4_size_16_color_FFFFFF_t_70_pic_center 2]  
点击主页–>关闭并上载就可以显示到Excel工作表中了  
![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3NpbmF0XzQxODcwMTQ4_size_16_color_FFFFFF_t_70_pic_center 3]  
![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3NpbmF0XzQxODcwMTQ4_size_16_color_FFFFFF_t_70_pic_center 4]

# VBA实现 #

## 实现逻辑 ##

`VBA`的实现逻辑是这样的  
![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3NpbmF0XzQxODcwMTQ4_size_16_color_FFFFFF_t_70_pic_center 5]

## 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`代码?参照下面这篇文章

> [如何运行一个宏][Link 1]

[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3NpbmF0XzQxODcwMTQ4_size_16_color_FFFFFF_t_70_pic_center]: /images/20221120/37dc965718944b4fb64389752a847f6c.png
[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3NpbmF0XzQxODcwMTQ4_size_16_color_FFFFFF_t_70_pic_center 1]: /images/20221120/b3a955b9c5cf46a5bad903908a9a2707.png
[20201101212304690.png_pic_center]: /images/20221120/e1bea50d3ba64ccfb988cd0f28825000.png
[20201101212428122.png_pic_center]: /images/20221120/0e9d56fada23406da1bb68e2d2732485.png
[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3NpbmF0XzQxODcwMTQ4_size_16_color_FFFFFF_t_70_pic_center 2]: /images/20221120/53b0947dadaf44f58868dfdd61847ae4.png
[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3NpbmF0XzQxODcwMTQ4_size_16_color_FFFFFF_t_70_pic_center 3]: /images/20221120/f2bd4fc9add2479a8923b4c6e1e49a37.png
[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3NpbmF0XzQxODcwMTQ4_size_16_color_FFFFFF_t_70_pic_center 4]: /images/20221120/2e939aca9daf4f43bb585f5dbfc21d6d.png
[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3NpbmF0XzQxODcwMTQ4_size_16_color_FFFFFF_t_70_pic_center 5]: /images/20221120/f2fb6029e84f495da1f519be583fdd5e.png
[Link 1]: https://mp.weixin.qq.com/s?__biz=MzU1NDkwNDkxMg==&mid=2247483905&idx=1&sn=83b1fd0940b6f9dc0e8b137914956843&chksm=fbdd3e3eccaab7281f599bf627868393618f09498f142a824a186be2fb130502785aa13fc0bc&key=942f56af7a259eb0bcfc98555c065bf0e6601b87353e493f7615c516eacc74436a343675af70c7e9dd2847a436d3002d671f30e7182a86b92374939b86385866e9ecdbc16ec207fbe8ccea0c76f6a10856a018ce1a8d8260c66f0d380775ee3c5a494a7f2f905585e810c4a002ed9265b3303a61de5c0fbe5d49446048fe0139&ascene=1&uin=MTI5NTY5NTQ4MQ%3D%3D&devicetype=Windows+10+x64&version=6300002f&lang=zh_CN&exportkey=AyPCqzL4SjqJ5wvLiYC7SL0%3D&pass_ticket=7lJMIKeZirEZBpW%2FJyoSWFkd8k2O8GoiQ9Xn76JCfPMH892t6ti%2BZvKn2nkxHSUt&wx_header=0