请求开发每日定时随机抽取10行商品的Excel VBA程序

核心功能实现代码 #

以下代码可完成从指定区域随机抽取10条不重复数据，并自动粘贴到目标工作表，同时支持每日定时执行：

Sub Daily10LineCount()
    Dim sourceWS As Worksheet, targetWS As Worksheet
    Dim lastRow As Long, randomRows(1 To 10) As Integer
    Dim i As Integer, r As Integer, isDuplicate As Boolean, j As Integer
    
    ' 绑定数据源和目标工作表
    Set sourceWS = ThisWorkbook.Worksheets("Specimens Back Office Feed")
    Set targetWS = ThisWorkbook.Worksheets("Today's 10 Line")
    
    ' 清空目标表已有数据（保留表头，从A2开始清除）
    targetWS.Range("A2:G" & targetWS.Cells(targetWS.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    ' 获取数据源有效行数（排除空行）
    lastRow = sourceWS.Cells(sourceWS.Rows.Count, "A").End(xlUp).Row
    ' 边界校验
    If lastRow < 2 Then
        MsgBox "数据源无有效数据！", vbExclamation
        Exit Sub
    End If
    If lastRow < 10 Then
        MsgBox "数据源不足10条，无法完成抽取！", vbExclamation
        Exit Sub
    End If
    
    ' 生成10个不重复的随机行号
    For i = 1 To 10
        Do
            ' 生成A2到最后一行的随机行号
            r = Int((lastRow - 1) * Rnd + 2)
            isDuplicate = False
            ' 检查是否已抽取过该行
            For j = 1 To i - 1
                If randomRows(j) = r Then
                    isDuplicate = True
                    Exit For
                End If
            Next j
        Loop Until isDuplicate = False
        randomRows(i) = r
    Next i
    
    ' 复制随机行数据到目标表
    For i = 1 To 10
        sourceWS.Rows(randomRows(i)).Range("A:G").Copy targetWS.Cells(i + 1, "A")
    Next i
    
    ' 自动保存工作簿
    ThisWorkbook.Save
End Sub

' 设置每日定时任务
Sub SetDailySchedule()
    Dim runTime As Date
    ' 修改此处设置每日运行时间，示例为早9点
    runTime = TimeValue("09:00:00")
    
    ' 清除已有定时任务，避免重复
    On Error Resume Next
    Application.OnTime EarliestTime:=runTime, Procedure:="Daily10LineCount", Schedule:=False
    On Error GoTo 0
    
    ' 新建定时任务
    Application.OnTime EarliestTime:=runTime, Procedure:="Daily10LineCount", Schedule:=True
    MsgBox "已设置每日" & Format(runTime, "HH:MM") & "自动执行10行盘点", vbInformation
End Sub

使用步骤 #

1. 打开目标Excel文件，按Alt + F11打开VBA编辑器
2. 在左侧「工程资源管理器」中右键点击你的工作簿，选择「插入」→「模块」
3. 将上述代码粘贴到新建模块中
4. 运行SetDailySchedule宏，按提示确认定时时间（可自行修改代码中的TimeValue参数调整执行时间）
5. 保持Excel处于打开状态（可最小化），定时任务会自动触发

常见故障排查 #

• 抽取重复数据：原代码未做去重校验，上述代码通过循环检查行号确保无重复
• 数据粘贴失败：检查源表和目标表的名称是否完全匹配（注意空格、大小写）
• 定时任务不触发：确保Excel未关闭，且已启用宏（文件→选项→信任中心→信任中心设置→宏设置→启用所有宏）
• 抽取到空行：代码通过lastRow获取实际有效数据行，自动排除空行干扰

内容的提问来源于stack exchange，提问作者Nicole Williams