随机化宏 - 需要生成多列数据,而不仅仅是第一列

问题描述 投票:0回答:1

此工具会生成一组随机的 10 个索赔编号 - 但我还有与这些索赔编号相对应的其他数据,我也希望显示这些数据。

它会生成 10 个随机索赔编号,但不仅仅是从 A 列生成索赔编号,我希望它还显示相应的福利类型(B 列)和索赔状态(C 列)

Sub RandomSelectionClaimsND()

    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet
    Dim sourceRange As Range
    Dim destRange As Range
    Dim numRows As Integer
    Dim selectedRows() As Integer
    Dim i As Integer
    Dim j As Integer
    
    ' Set the source and destination sheets
    Set sourceSheet = ThisWorkbook.Sheets("Claims data")
    Set destSheet = ThisWorkbook.Sheets("Claims ND")
    
    ' Set the source range to the first column of the source sheet
    Set sourceRange = sourceSheet.Range("A:A")
    
    ' Determine the number of rows in the source range
    numRows = sourceSheet.Cells(sourceSheet.Rows.Count, sourceRange.Column).End(xlUp).Row
    
    ' Create an array to hold the row numbers of the selected items
    ReDim selectedRows(1 To 10)
    
    ' Select ten random rows
    For i = 1 To 10
        ' Generate a random row number between 1 and the number of rows in the source range
        selectedRows(i) = Int((numRows - 1 + 1) * Rnd + 1)
        
        ' Check if this row has already been selected
        For j = 1 To i - 1
            If selectedRows(i) = selectedRows(j) Then
                ' If it has, generate a new row number and try again
                i = i - 1
                Exit For
            End If
        Next j
    Next i
    
    ' Sort the selected rows in ascending order
    Call BubbleSort(selectedRows, 10)
    
    ' Copy the selected rows to the destination sheet
    Set destRange = destSheet.Range("A:A")
    For i = 1 To 10
        sourceRange.Cells(selectedRows(i), 1).Copy destRange.Cells(i + 1, 1)
    Next i
    
End Sub

Sub BubbleSort(arr() As Integer, n As Integer)
    
    Dim i As Integer
    Dim j As Integer
    Dim temp As Integer
    
    For i = 1 To n - 1
        For j = i + 1 To n
            If arr(i) > arr(j) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
    
End Sub
vba macos range
1个回答
0
投票

如果您想复制更多单元格,您可以添加(例如)

sourceRange.Cells(selectedRows(i), 2).Copy destRange.Cells(i + 1, 2) 
sourceRange.Cells(selectedRows(i), 3).Copy destRange.Cells(i + 1, 3)

或者(因为您的单元格相邻):

sourceRange.Cells(selectedRows(i), 1).Resize(1, 3).Copy destRange.Cells(i + 1, 1) 
© www.soinside.com 2019 - 2024. All rights reserved.