有个女人叫小美，为加强外库管理，她需要每天导出一个Excel综合库存表，筛选出某些条件后，从5个不同的仓库中分别随机抽取出10条数据，进行盘查。尝试过用AI写代码，但报错无法运行。录制过一段宏，由于每天每个仓库的数据在变化，无法实现抽样功能，请问各位大佬有什么办法吗？文件太大无法上传

使用的WPS软件，附件是录制的一部分宏功能和最终要实现结果

导出的Excel综合库存表长什么样子, 样例数据总得提供一下吧

Sub RandomSampleByWarehouseSimple()
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim dict As Object
    Dim i As Long, j As Long, k As Long
    Dim warehouseCol As Long, sampleSize As Integer
    Dim warehouseName As String
    
    ' 设置参数
    Set wsSource = ThisWorkbook.Worksheets("9.15")
    sampleSize = 5
    warehouseCol = 42 ' B列
    lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    lastCol = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
    
    ' 创建目标工作表
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets("抽样结果").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set wsDest = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    wsDest.Name = "抽样结果"
    
    ' 复制表头
    wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(1, lastCol)).Copy wsDest.Range("A1")
    
    ' 使用字典存储行号
    Set dict = CreateObject("Scripting.Dictionary")
    
    For i = 2 To lastRow
        warehouseName = wsSource.Cells(i, warehouseCol).Value
        If Not dict.Exists(warehouseName) Then
            Set dict(warehouseName) = New Collection
        End If
        dict(warehouseName).Add i
    Next i
    
    Application.ScreenUpdating = False
    
    ' 随机抽样并复制
    Dim destRow As Long: destRow = 2
    For Each Key In dict.Keys
        Dim arr() As Long
        Dim n As Long: n = dict(Key).Count
        ReDim arr(1 To n)
        
        For k = 1 To n
            arr(k) = dict(Key)(k)
        Next k
        
        ' 随机排序
        Randomize
        For k = n To 2 Step -1
            Dim randIndex As Long: randIndex = Int(Rnd * k) + 1
            Dim temp As Long: temp = arr(k)
            arr(k) = arr(randIndex)
            arr(randIndex) = temp
        Next k
        
        ' 复制数据
        Dim actualSample As Long: actualSample = WorksheetFunction.Min(sampleSize, n)
        For k = 1 To actualSample
            For j = 1 To lastCol
                wsDest.Cells(destRow, j).Value = wsSource.Cells(arr(k), j).Value
            Next j
            destRow = destRow + 1
        Next k
    Next Key
    
    ' 转换为Table
    Dim tbl As ListObject
    Set tbl = wsDest.ListObjects.Add(xlSrcRange, wsDest.Range("A1").CurrentRegion, , xlYes)
    tbl.Name = "RandomSampleResults"
    tbl.TableStyle = "TableStyleMedium2"
    
    wsDest.Columns.AutoFit
    Application.ScreenUpdating = True
    
End Sub

以上vba可以从你提供的excel结果表的9.15中的每个仓库中随机抽取出5条数据

感谢，让我来try 一try