分享一个能协助写VBA代码的简单易用的chat工具

金涌浩

这个不用翻墙也不用充值，可以直接用来写代码，亲测让它写了抽奖代码，获取文件名，纸牌游戏等代码，基本能够正常运行，分享给各位。

金涌浩

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

金涌浩

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

金涌浩

我
在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

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