ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 174|回复: 0

请帮忙修改相关代码,能实现已经被抽中奖的员工,不会在下个奖项中再被抽中。

[复制链接]

TA的精华主题

TA的得分主题

发表于 2023-12-21 09:05 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
帮忙修改以下代码,能实现已经被抽中奖的员工,不会在抽取下个奖项中再被抽中。谢谢

Private Sub 一等奖_Click()     UserForm1.TextBox1.Text = ""     抽取一等奖End SubPrivate Sub 二等奖_Click()     UserForm1.TextBox1.Text = ""     抽取二等奖End SubPrivate Sub 三等奖_Click()     UserForm1.TextBox1.Text = ""     抽取三等奖End SubPrivate Sub 四等奖_Click()     UserForm1.TextBox1.Text = ""     抽取四等奖End SubPrivate Sub 特别奖_Click()     UserForm1.TextBox1.Text = ""     抽取特别奖End SubPrivate Sub UserForm_Initialize() Me.TextBox1.MultiLine = True    Me.TextBox1.TextAlign = fmTextAlignCenter ' 使用 fmTextAlignCenter 代替 2,以实现文本居中显示    AutoAdjustTextBoxHeight Me.TextBox1    Dim 员工姓名 As Collection    Set 员工姓名 = New Collection    Dim cell As Range    For Each cell In Range("A2:A40")        员工姓名.Add cell.Value    Next cell    Dim J1 As String, J2 As String, J3 As String, J4 As String, J5 As String, J6 As String    Randomize    ' 抽取一等奖    Dim i As Integer    For i = 1 To 3        index = Int((员工姓名.count * Rnd) + 1)        J1 = 员工姓名(index)        员工姓名.Remove index    Next i    ' 抽取三等奖    Dim J As Integer    For J = 1 To 2        index = Int((员工姓名.count * Rnd) + 1)        J2 = 员工姓名(index)        员工姓名.Remove index    Next J    Dim K As Integer    For K = 1 To 2        index = Int((员工姓名.count * Rnd) + 1)        J3 = 员工姓名(index)        员工姓名.Remove index    Next K    Dim L As Integer    For L = 1 To 2        index = Int((员工姓名.count * Rnd) + 1)        J4 = 员工姓名(index)        员工姓名.Remove index    Next L    End SubPrivate Sub UserForm11_Initialize()    Me.TextBox1.MultiLine = True    Me.TextBox1.TextAlign = fmTextAlignCenter ' 使用 fmTextAlignCenter 代替 2,以实现文本居中显示    ' 示例文本,您需要根据实际情况设置文本框的内容  '  Me.TextBox1.Text = "这是一段较长的示例文本,当文本内容超出文本框的宽度时,它将自动换行并居中显示。"    ' 调整文本框的高度以适应文本内容    AutoAdjustTextBoxHeight Me.TextBox1End SubPrivate Sub AutoAdjustTextBoxHeight(textBox As Object)    Dim lineHeight As Long    Dim lineCount As Long    lineHeight = textBox.Font.Size + 5 ' 设置行高,可以根据实际情况调整    lineCount = Round(textBox.Height / lineHeight) ' 根据文本框当前高度计算最大行数    ' 计算实际行数    Dim textLines() As String    textLines = Split(textBox.Text, vbCrLf) ' 分割文本为行    If UBound(textLines) + 1 > lineCount Then        lineCount = UBound(textLines) + 1        textBox.Height = lineHeight * (lineCount + 1) ' 调整文本框高度以适应文本内容    End IfEnd SubFunction RemoveElement(arr As Variant, index As Integer) As Variant    Dim i As Integer    Dim newArr() As Variant    ReDim newArr(1 To UBound(arr) - 1, 1 To 1)    For i = 1 To UBound(arr)        If i < index Then            newArr(i, 1) = arr(i, 1)        ElseIf i > index Then            newArr(i - 1, 1) = arr(i, 1)        End If    Next i    RemoveElement = newArrEnd FunctionSub 抽取一等奖()    '调用抽奖程序    Call 抽奖程序(3)End SubSub 抽取二等奖()    '调用抽奖程序    Call 抽奖程序(6)End SubSub 抽取三等奖()    '调用抽奖程序    Call 抽奖程序(9)End SubSub 抽取四等奖()    '调用抽奖程序    Call 抽奖程序(12)End SubSub 抽取特别奖()    '调用抽奖程序    Call 抽奖程序(20)End SubSub 抽奖程序1(奖项人数 As Integer)    '定义员工姓名数组    Dim 员工姓名() As Variant    员工姓名 = Range("A2:A40") '假设员工姓名数据在A2:A101单元格区域中存储    '定义抽奖结果变量    Dim 抽奖结果 As String    '定义随机数生成器    Randomize    '抽取奖项人数名单    Dim i As Integer    Dim index As Integer    For i = 1 To 奖项人数        index = Int((UBound(员工姓名) - 1 + 1) * Rnd + 1)        抽奖结果 = 抽奖结果 & 员工姓名(index, 1) & " "        '从数组中删除已中奖员工       员工姓名.Remove index '员工姓名 = RemoveElement(员工姓名, index)    Next i    '去除最后一个顿号    '抽奖结果 = Left(抽奖结果, Len(抽奖结果) - 1)    '将抽奖结果显示在抽奖窗体的文本框中    UserForm1.TextBox1.TextAlign = fmTextAlignCenter    UserForm1.TextBox1.Text = 抽奖结果End SubSub 抽奖程序(奖项人数 As Integer)    '定义员工姓名数组    Dim 员工姓名() As Variant    员工姓名 = Range("A2:A40") '假设员工姓名数据在A2:A101单元格区域中存储    '定义抽奖结果变量    Dim 抽奖结果 As String    '定义随机数生成器    Randomize    '抽取奖项人数名单    Dim i As Integer    Dim index As Integer    Dim temp As Variant    '创建一个临时数组存储已中奖员工    temp = Array()        For i = 1 To 奖项人数        '检查当前员工是否已中奖                   index = Int((UBound(员工姓名) - 1 + 1) * Rnd + 1)             If Not IsArray(Array(员工姓名(index, 1))) Then            抽奖结果 = 抽奖结果 & 员工姓名(index, 1) & " "            temp = Array(temp, 员工姓名(index, 1))        Else            '生成一个新的未中奖员工            index = Int((UBound(员工姓名) - 1 + 1) * Rnd + 1)            抽奖结果 = 抽奖结果 & 员工姓名(index, 1) & " "            temp = Array(temp, 员工姓名(index, 1))        End If                '从数组中删除已中奖员工       员工姓名 = RemoveElement(员工姓名, index)    Next i        '去除最后一个顿号    '抽奖结果 = Left(抽奖结果, Len(抽奖结果) - 1)    '将抽奖结果显示在抽奖窗体的文本框中    UserForm1.TextBox1.TextAlign = fmTextAlignCenter    UserForm1.TextBox1.Text = 抽奖结果End Sub

BBF.7z

19.14 KB, 下载次数: 5

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-5-22 02:07 , Processed in 0.025656 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表