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

Question

I have a problem with Excel VBA coding.

I want to make one coding may copy data from one sheet to a sheet with certain conditions. my data in the form binary.

data in sheet1 has nearly a thousand row. I just want to take 15 random row of data from sheet1 to sheet 2. The criteria which must be fulfilled is that one specific column the sum of the column is 12. if not met, other data will be taken.

Example of data

Example of outcome

Here is my coding, but it doesn't work.

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

To take a random (pseudorandom, to be accurate) number, you can use Rnd function. It gives you a value in range form 0 to 1. To get some particular number from range, you can use this solution . So, to get a random number from your range of row 2 to last , you can do for example:

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)

Now you need to take this 15 times, and be sure that you wont get the same row multiple times. We can use array, and store row numbers inside. Unfortunately, VBA has no function to check if some particular value is inside. We to do it by looping through the values.

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

No we have to check, if sum of values in random rows are equal to 12, and if not, loop the whole process. The whole thing will look like:

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

When loop will end, you gonna have array rowArr containing 15 rows, which sum of values in column G is equal to 12.