Question

我的Excel VBA编码存在问题。

我想让一个编码可以将数据从一张纸复制到具有特定条件的纸张。我的数据是二进制格式。

sheet1中的数据有近千行。我只想从sheet1到sheet 2获取15个随机数据行。必须满足的标准是列的总和为12的一个特定列。如果不满足，则将采用其他数据。

数据示例

结果示例

这是我的编码，但它不起作用。

dim clm , ClmTtl as integer
for row = 1 to 1000
    ClmTtl = ClmTtl + Sheets(1).Cells(row,8).Value
next
if not ClmTtl = 12 then call CommandButton1_click

er`

Answer 1

要采用随机（伪随机，准确）数字，您可以使用Rnd函数。它为您提供范围从0到1的值。要从范围中获取某个特定数字，您可以use this solution。因此，要从第2行到最后一行获取随机数，您可以执行以下操作：

Dim LastRow As Long, rRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row ' Last row based on column A
rRow = Int((LastRow - 2 + 1) * Rnd + 2)

现在你需要这15次，并确保你不会多次获得同一行。我们可以使用数组，并在里面存储行号。不幸的是，VBA无法检查是否存在某些特定值。我们通过循环遍历值来完成它。

Dim LastRow As Long, rRow As Long
Dim rowArr(14) As Long
Dim found As Boolean
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 0 To 14
    rRow = Int((LastRow - 2 + 1) * Rnd + 2)
    found = False
    If i > 0 Then
        For j = i - 1 To 0 Step -1
            If rowArr(j) = rRow Then found = True
        Next j
    End If
    If found Then
        i = i - 1
    Else
        rowArr(i) = rRow
    End If
Next i

不，我们必须检查，如果随机行中的值的总和等于12，如果不是，则循环整个过程。整个事情看起来像：

Dim LastRow As Long, rRow As Long
Dim rowArr(14) As Long
Dim found As Boolean, mainCriterium As Boolean
Dim sumOfValues As Double

mainCriterium = False

Do While mainCriterium = False
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    For i = 0 To 14
        rRow = Int((LastRow - 2 + 1) * Rnd + 2)
        found = False
        If i > 0 Then
            For j = i - 1 To 0 Step -1
                If rowArr(j) = rRow Then found = True
            Next j
        End If
        If found Then
            i = i - 1
        Else
            rowArr(i) = rRow
        End If
    Next i
    For i = 0 To 14
        sumOfValues = sumOfValues + Range("G" & rowArr(i)).Value
    Next i
    If sumOfValues = 12 Then mainCriterium = True
Loop

当循环结束时，你将拥有包含15行的数组rowArr，G列中的值之和等于12。

复制并粘贴某些列条件vba excel

1 个答案: