do while循环在excel vba错误 [英] do while loop in excel vba error

问题描述

我有一个Excel VBA编码的问题。

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.

sheet1中的数据有近千行。我只想从sheet1到sheet2中获取15个随机数据。必须满足的条件是每列只有列的总和为3.如果不满足，其他数据将被采取，它不能工作？我想循环直到ClmTtl不是3，我该如何解决？
请帮我或者我可以用其他方法吗？

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 each column only has the sum of the column is 3. if not met, other data will be takenwhy it cannot work? i want to loop until ClmTtl is not 3, how can i fix it? please help me. or can i do with other method?

Randomize 'Initialize Random number seed
Dim MyRows() As Integer    ' Declare dynamic array.
Dim numRows, percRows, finalClm, nxtRow, nxtRnd, chkrnd, copyRow As Integer
'Application.Calculation = xlCalculationManual
'Application.ScreenUpdating = False
'Application.EnableEvents = False
'Determine Number of Rows in Sheet1 Column A
  numRows = Sheets(1).Cells(Rows.count, "A").End(xlUp).Row

'Get 20% of that number
   percRows = 15

Dim clm, ClmTtl As Integer

'Allocate elements in Array

ReDim MyRows(percRows)

'Create Random numbers and fill array
Do While ClmTtl <> 3
  For nxtRow = 1 To percRows
getNew:
'Generate Random number
    nxtRnd = Int((numRows) * Rnd + 1)

'Loop through array, checking for Duplicates
    For chkrnd = 1 To nxtRow
'Get new number if Duplicate is found
      If MyRows(chkrnd) = nxtRnd Then GoTo getNew
    Next
'Add element if Random number is unique
    MyRows(nxtRow) = nxtRnd
  Next
  For clm = 1 To 5
    ClmTtl = 0
    For copyRow = 1 To percRows
      ClmTtl = ClmTtl + Sheets(1).Cells(MyRows(copyRow), clm).Value
    Next        
  Next
Loop

 For copyRow = 1 To percRows
   Sheets(1).Rows(MyRows(copyRow)).Copy _
     Destination:=Sheets(3).Cells(copyRow, 1)
 Next

'Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
'Application.EnableEvents = True
 End Sub

推荐答案

Den Temple是正确的，你真的应该Dim变量独立，这里的真正问题是逻辑：

While Den Temple is correct, and you really should Dim variables independently, the real problem here is with the logic of:

For clm = 1 To 5
  ClmTtl = 0

   For copyRow = 1 To percRows
       ClmTtl = ClmTtl + Sheets(1).Cells(MyRows(copyRow), clm).Value
   Next

Next

这将清除 ClmTtl 每次，不要与你刚刚计算的总和做任何事情。因此，您只会检查您选择的最后一列。您需要在循环中添加一个检查，如果任何总计不是3，则会触发该检查，并且基于此执行 While 循环。

This clears ClmTtl each time, without doing anything with the total you've just calculated. Thus you're only checking the final column that you have picked. You'll need to add in a check within the loop which gets triggered if any of the totals is not 3, and have the While loop based on that.

每次您执行do循环时，您也不会清除 MyRows ，所以如果第一次失败每次都会失败。

You are also not clearing MyRows each time you go through the do loop, so if it fails the first time, it will fail every time.

您的循环可能会更好，如下所示：

Your loop might be better as something like:

    Dim claimTotalCheck As Boolean
    claimTotalCheck = True
    Do While claimTotalCheck
        ReDim MyRows(percRows)
        For nxtRow = 1 To percRows
getNew:
        'Generate Random number
            nxtRnd = Int((numRows) * Rnd + 1)

        'Loop through array, checking for Duplicates
            For chkrnd = 1 To nxtRow
        'Get new number if Duplicate is found
                If MyRows(chkrnd) = nxtRnd Then GoTo getNew
            Next
        'Add element if Random number is unique
            MyRows(nxtRow) = nxtRnd
        Next

        claimTotalCheck = False
        For clm = 1 To 5
           ClmTtl = 0

            For copyRow = 1 To percRows
                ClmTtl = ClmTtl + Sheets(1).Cells(MyRows(copyRow), clm).Value
            Next

            If ClmTtl <> 3 Then
                claimTotalCheck = True
            End If
        Next
    Loop

这篇关于do while循环在excel vba错误的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！