Excel VBA 用于在每天设定的时间从列表中选择随机行

Question

我有一张 Excel 工作表，用于处理我们销售的所有商品，每天我们都会进行 10 行计数，我希望 Excel 工作表能够自行更新，挑选 10 个随机产品进行计数，每天它们都会进行计数。不同。

我喜欢这样，VBA 在一天中的设定时间启动并更改需要计数的内容。

需要计数的项目与 10 行计数位于不同的工作表上，因此项目的完整列表位于名为“样本后台提要”的页面上，而第 10 行（需要粘贴 10 个项目）是在一个名为“今日 10 号线”的页面上

需要复制的行是从A2:G2一直到G500。

如果有人可以帮助我创建一个 VBA，这对我有什么帮助，我将非常感激。

上周我自己创建这个已经很累了，但似乎总是有错误。

Private Sub auto_open() 
    MsgBox "New 10 line updated!" 
End Sub 

Sub getting_new_specimens() 
' ' getting_new_specimens Macro ' ' 
    Range( _ "A3:G3,A7:G7,A10:G10,A12:G12,A14:G14,A20:G20,A17:G17,A15:G15,A5:G5,A23:G23"). _ 
    Select 
    Range("A23").Activate 
    Selection.Copy 
    Sheets("Today's 10 Line").Select 
    Range("A8:G18").Select 
    ActiveSheet.Paste 
End Sub 

Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    If Saved = False Then 
        ActiveWorkbook.Save 
    End If 
End Sub

Answer 1

试试这个：

Sub PickRandomLines()
    Const NUM_ITEMS As Long = 10 '# of random rows to pick
    Dim wsSpec As Worksheet, wsTen As Worksheet, rng As Range
    Dim dict As Object, r As Long, cDest As Range, lastRow
    
    Set dict = CreateObject("scripting.dictionary")
    Set wsSpec = ThisWorkbook.Worksheets("Specimens Back Office Feed")
    Set wsTen = ThisWorkbook.Worksheets("Todays 10 Line")
    
    lastRow = wsSpec.Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = wsSpec.Range("A1:G" & lastRow)      'source range
    
    Application.ScreenUpdating = False
    Set cDest = wsTen.Range("A2")                 'paste starting here
    Do While dict.Count < NUM_ITEMS               'loop until 10 rows copied
        r = Application.RandBetween(2, lastRow)   'pick random row number (exclude header)
        If Not dict.Exists(r) Then                'not already picked?
            rng.Rows(r).Copy cDest                'copy this row
            Set cDest = cDest.Offset(1)           'next paste location
            dict.Add r, True                      'remember this row
        End If
    Loop
End Sub