Question

我的Excel VBA编码存在问题。

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

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

this what i get

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

Answer 1

编辑：@bobajob对您的问题可能有更具体的答案。

在不了解错误的情况下，我可能无法给您一个完整的答案，但我绝对可以指出您的代码存在一个关键问题。

您的Dim陈述没有按照您认为他们正在做的事情。

例如，Dim numRows, percRows, finalClm, nxtRow, nxtRnd, chkrnd, copyRow As Integer不会创建七个不同的整数变量。它创建了六个不同的变量变量和一个整数变量。

我建议将所有声明分开并将它们放在自己的行上，然后从那里取出。

像这样：

Dim numRows As Integer
Dim percRows As Integer
...

Answer 2

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

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循环。

每次进行do循环时，你也没有清除MyRows，所以如果它第一次失败，它每次都会失败。

你的循环可能更好，如：

    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

在excel vba错误中执行while循环

2 个答案: