使用VBA生成分组名单

核酸检测要求每天按照百分比划定抽检名单,为实现每组人数相同,本班最后一名之后要紧跟第一名。为了简化分组工作,同时做到简单易用,我们可以借助Excel中内置的 VBA (Visual Basic for Applications)来实现这个需求。

分析

需求并不复杂,可以使用类似循环数组的方式,这里我们可以采用指针移位的方式。

Sheet1 原始数据

Sheet2 生成数据

VBA代码:

Sub make()

Dim i, j, k As Integer
Dim class, persons, times, days As Integer
Dim persent As Double
Dim cnt As Integer

Rem 获取初始内容
class = Application.WorksheetFunction.CountA(Sheet1.Range("7:7")) - 1 :Rem 获取班级列表
present = Sheet1.Range("c1").Value / 100 :Rem 获取抽测百分比
times = Sheet1.Range("c2").Value :Rem 获取抽测组数
Sheet2.Range(Sheet2.Cells(2, 1), Sheet2.Cells(100, 100)).ClearContents :Rem 清除单元格,避免数据出错

Rem 向sheet2中填充班级
For i = 1 To class Step 1
    Sheet2.Cells(i + 1, 1) = Sheet1.Cells(7, i + 1)
Next i

Rem 开始生成分组
For i = 1 To class Step 1
    persons = Application.WorksheetFunction.CountA(Sheet1.Range(Sheet1.Cells(8, i + 1), Sheet1.Cells(108, i + 1))) :Rem 获取本班人数
    days = persons * present :Rem 计算出每组人次
    cnt = Sheet1.Range("c3").Value + 7 :Rem cnt是一个浮动指针,+7的偏移量是基于sheet1的布局设计
    For j = 1 To times Step 1
        For k = 1 To days Step 1
            Sheet2.Cells(i + 1, j + 1) = Sheet2.Cells(i + 1, j + 1) & Chr(10) & Sheet1.Cells(cnt, i + 1) :Rem 开始填充数据
            cnt = cnt + 1 :Rem 指向下一个人
            If cnt > persons + 7 Then  :Rem 判断是否到达最后一人,如果是,则重置cnt到第一位,另一种替代方式是直接对cnt取余+8
                cnt = 8
            End If
        Next k
    Next j
Next i

End Sub

 

暂无评论

发送评论 编辑评论


				
|´・ω・)ノ
ヾ(≧∇≦*)ゝ
(☆ω☆)
(╯‵□′)╯︵┴─┴
 ̄﹃ ̄
(/ω\)
∠( ᐛ 」∠)_
(๑•̀ㅁ•́ฅ)
→_→
୧(๑•̀⌄•́๑)૭
٩(ˊᗜˋ*)و
(ノ°ο°)ノ
(´இ皿இ`)
⌇●﹏●⌇
(ฅ´ω`ฅ)
(╯°A°)╯︵○○○
φ( ̄∇ ̄o)
ヾ(´・ ・`。)ノ"
( ง ᵒ̌皿ᵒ̌)ง⁼³₌₃
(ó﹏ò。)
Σ(っ °Д °;)っ
( ,,´・ω・)ノ"(´っω・`。)
╮(╯▽╰)╭
o(*////▽////*)q
>﹏<
( ๑´•ω•) "(ㆆᴗㆆ)
😂
😀
😅
😊
🙂
🙃
😌
😍
😘
😜
😝
😏
😒
🙄
😳
😡
😔
😫
😱
😭
💩
👻
🙌
🖕
👍
👫
👬
👭
🌚
🌝
🙈
💊
😶
🙏
🍦
🍉
😣
Source: github.com/k4yt3x/flowerhd
颜文字
Emoji
小恐龙
花!
上一篇
下一篇