Excel VBA程序开发

金涌浩 Lv.2

关注

这个不用翻墙也不用充值,可以直接用来写代码,亲测让它写了抽奖代码,获取文件名,纸牌游戏等代码,基本能够正常运行,分享给各位。
微信截图_20230322131840.jpg
436阅读
3回复 倒序

金涌浩 楼主 2楼

image.png
扫码注册即可使用,直接提问即可,但问题要尽量说清楚具体情况

金涌浩 楼主 3楼

昨天我还在学习正则表达式,今天就发现,我只要向gpt提问,它就能直接写好我需要的表达式,科技进步的太快了,

金涌浩 楼主 4楼


在Excel中用vba代码写一个抽奖小工具,每点击一次抽奖按钮能从a列名单中抽取一个中奖者

以下是 VBA 代码示例,实现一个简单的抽奖小工具,点击按钮后能够从 A 列名单中抽取一个中奖者:

Sub LuckyDraw()
    Dim lastRow As Integer
    Dim winnerRow As Integer
    Dim winnerName As String
    Dim randNum As Integer
   
    ' 获取名单的最后一行行号
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
   
    If lastRow < 2 Then
        ' 如果名单为空,提示用户需要先添加名单
        MsgBox "名单为空,请先添加名单。"
        Exit Sub
    ElseIf lastRow = 2 Then
        ' 如果名单中只有一人,直接选中该人为中奖者
        winnerRow = 2
    Else
        ' 在名单行数范围内随机选中一个数
        randNum = Int((lastRow - 2 + 1) * Rnd + 2)
        winnerRow = randNum
    End If
   
    ' 获取中奖者的姓名
    winnerName = Range("A" & winnerRow).Value
   
    ' 将中奖者的姓名输出到消息框中
    MsgBox "恭喜 " & winnerName & " 获得奖励!"
End Sub
请注意,上面的代码中需要将 "A" 的部分改为您名单列表的列标,如果您的列表在其他列中,如 "B"、"C" 等,需要相应修改。另外,如需要在选取中奖者后从名单中删除该中奖者,请在程序中添加相关代码。


需要在选取中奖者后从名单中删除该中奖者,请添加相关代码。

以下是根据之前的代码,添加了从名单中删除中奖者的相关代码:

Sub LuckyDraw()
    Dim lastRow As Integer
    Dim winnerRow As Integer
    Dim winnerName As String
    Dim randNum As Integer
   
    ' 获取名单的最后一行行号
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
   
    If lastRow < 2 Then
        ' 如果名单为空,提示用户需要先添加名单
        MsgBox "名单为空,请先添加名单。"
        Exit Sub
    ElseIf lastRow = 2 Then
        ' 如果名单中只有一人,直接选中该人为中奖者
        winnerRow = 2
    Else
        ' 在名单行数范围内随机选中一个数
        randNum = Int((lastRow - 2 + 1) * Rnd + 2)
        winnerRow = randNum
    End If
   
    ' 获取中奖者的姓名
    winnerName = Range("A" & winnerRow).Value
   
    ' 在列表中删除中奖者
    Range("A" & winnerRow).Delete Shift:=xlUp
   
    ' 更新名单的最后一行行号
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
   
    ' 如果名单为空,输出提示框并退出程序
    If lastRow < 2 Then
        MsgBox "已抽完所有中奖者,名单为空。"
        Exit Sub
    End If
   
    ' 将中奖者的姓名输出到消息框中
    MsgBox "恭喜 " & winnerName & " 获得奖励!"
End Sub
在这个代码中,删除中奖者名字的代码是 ,我们使用了 方法,并且指定了 ,将删除后的单元格上移,相当于删除了整行。删除后,我们需要更新名单的最后一行行号。最后,如果名单为空,我们会输出一个提示框来告诉用户已经抽完了所有中奖者。Range("A" & winnerRow).Delete Shift:=xlUpDeleteShift:=xlUp


添加"抽奖"按钮,添加抽奖动画

以下是 VBA 代码示例,实现在 Excel 中添加一个“抽奖”按钮,并在用户点击按钮时,添加一个抽奖动画效果,抽奖完成后显示中奖者姓名:

首先,我们需要在工具栏中添加一个按钮,用户点击该按钮即可进行抽奖操作。在 Excel 的开发者选项卡中,选择 插入 控件,选择'图像',然后选择'按钮',在 Excel 工作表上绘制一个按钮。

然后,双击按钮,打开 VBA 编辑器,在该按钮的代码模块中添加以下代码:

Option Explicit

Private Sub CommandButton1_Click()
    Dim lastRow As Integer
    Dim winnerRow As Integer
    Dim winnerName As String
    Dim randNum As Integer
    Dim i As Integer
   
    ' 获取名单的最后一行行号
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
   
    If lastRow < 2 Then
        ' 如果名单为空,提示用户需要先添加名单
        MsgBox "名单为空,请先添加名单。"
        Exit Sub
    ElseIf lastRow = 2 Then
        ' 如果名单中只有一人,直接选中该人为中奖者
        winnerRow = 2
    Else
        ' 在名单行数范围内随机选中一个数作为中奖者
        For i = 1 To 30
            randNum = Int((lastRow - 2 + 1) * Rnd + 2)
            winnerRow = randNum
            
            ' 显示动画效果,让程序休眠
            For j = 1 To 500
                DoEvents
            Next j
            
            ' 重绘按钮,显示动画效果
            CommandButton1.Caption = Range("A" & winnerRow).Value
        Next i
    End If
   
    ' 获取中奖者的姓名
    winnerName = Range("A" & winnerRow).Value
   
    ' 在列表中删除中奖者
    Range("A" & winnerRow).Delete Shift:=xlUp
   
    ' 更新名单的最后一行行号
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
   
    ' 如果名单为空,输出提示框并退出程序
    If lastRow < 2 Then
        MsgBox "已抽完所有中奖者,名单为空。"
        Exit Sub
    End If
   
    ' 将中奖者的姓名输出到消息框中
    MsgBox "恭喜 " & winnerName & " 获得奖励!"
End Sub
这个代码会在点击"抽奖"按钮时执行,先检查名单是否为空,如果为空就提示用户添加名单。如果名单中只有一个人,直接选中该人为中奖者。如果名单中有多个人,则在名单中随机选择一个作为中奖者,同时显示一个简单的动画效果,让用户感受到程序的交互性和趣味性。

在执行"动画效果"的代码时,我们使用了一个简单的循环,循环中让程序休眠一段时间,然后重新绘制按钮文字,实现了一个非常简单、但趣味性十足的动画。请注意,这里我们用到了 方法,这个方法可以使代码允许其他事件在此期间发生,比如用户取消了操作或输入了新的数据。如果不加 的话,程序会在循环结束之前将所有事件挂起,导致界面无响应。DoEventsDoEvents

最后,代码会将中奖者的姓名输出到消息框中,并从名单中删除该中奖者。如果名单为空,则在消息框中输出提示信息。

已显示全部内容