☰

如何添加命令来跳过重复项？

tag-icon • tag-icon microsoft-excel
如何添加命令来跳过重复项？

我有以下宏。我用它来对行进行采样，但我想编辑它以跳过已选择的行。有人能提供解决方案吗？

Sub GenerateSample()

Dim all As Range
Dim selRange As Range
Dim output() As Integer

    interval = Evaluate(Names("SampleInterval").Value)
    'Sampling
    ''Select all POPULATION transactions
    Set all = Sheets("Population").Range("Population")
    Set last_cell = GetLastCell(all, xlByRows)
    Set p = Range(all.Cells(2), last_cell)
    'for debuging
    'MsgBox (p.Count)

    ''To set random starting point
    Randomize
    Lower = 0
    sampling = Int((interval - Lower + 1) * Rnd + Lower)
    cnt = 2
    accumulator = p.Cells(2).Value
    Do Until cnt >= p.Count
    '' Sampling when count there
        If accumulator < sampling Then
            cnt = cnt + 1
            accumulator = accumulator + Abs(p.Cells(cnt).Value)
        Else
            ret = AppendArray(output, cnt)
            sampling = sampling + interval
        End If
    Loop
    ' End of Sampling

    'Prepare Sample Listing output area
    Set selRange = Sheets("Main").Range("SAMPLEAREA_LIST")
    ttl_rows = selRange.Rows.Count
    rows_needed = UBound(output)

    '' Insert rows if it is less than needed.
    If ttl_rows < rows_needed Then
        Cells(selRange.Row, 1).Activate
        For i = ttl_rows To rows_needed
           ActiveCell.Offset(1).EntireRow.Insert
        Next i
    End If

    '' Delete rows if it is more than needed.
    If ttl_rows > rows_needed Then
        Cells(selRange.Row, 1).Activate
        For i = ttl_rows To rows_needed + 1 Step -1
            ActiveCell.Offset(1).EntireRow.Delete
        Next i
    End If

    selRange.ClearContents
    For i = 1 To rows_needed
        ''' print sample number
        Cells(selRange.Row + i - 1, 2).Value = i
        ''' print reference number
        Cells(selRange.Row + i - 1, 3).Value = Sheets("Population").Cells(output(i), 1)
        ''' print date
        Cells(selRange.Row + i - 1, 4).Value = Sheets("Population").Cells(output(i), 2)
        ''' print amount
        Cells(selRange.Row + i - 1, 5).Value = Sheets("Population").Cells(output(i), 3)
        ''' prepare calculation for misstatementprint amount
        Cells(selRange.Row + i - 1, 7).Formula = "=ABS(RC[-2])-ABS(RC[-1])"
        ''' prepare calculation for % of misstatementprint
        Cells(selRange.Row + i - 1, 8).Formula = "=RC[-1]/RC[-2]"
    Next i
    selRange.Columns(2).NumberFormat = "General"
    selRange.Columns(3).NumberFormat = "General"
    selRange.Columns(4).NumberFormat = "yyyy-mm-dd"
    selRange.Columns(5).NumberFormat = "#,##0.00_);[Red](#,##0.00)"

End Sub

答案1

在您的代码中，您使用以下命令生成随机索引：

sampling = Int((interval - Lower + 1) * Rnd + Lower)

这有效，但允许随机重复。另一种方法是

  • 创建一个固定的索引数组
  • 打乱索引
  • 使用索引

这确保不会重复（因为索引中没有重复）

以下是两种随机抽样的示例：

Public ary(1 To 10) As String

Sub MAIN()
   ary(1) = "Cordelia"
   ary(2) = "Ophelia"
   ary(3) = "Bianca"
   ary(4) = "Cressida"
   ary(5) = "Desdemona"
   ary(6) = "Juliet"
   ary(7) = "Portia"
   ary(8) = "Rosalind"
   ary(9) = "Mab"
   ary(10) = "Belinda"

   Call MightRepeat
   Call WillNotRepeat
End Sub

Sub MightRepeat()
   Randomize
   Lower = 1
   interval = 10

    For iTimes = 1 To 3
      sampling = Int((interval - Lower) * Rnd + Lower)
      MsgBox iTimes & vbCrLf & sampling & vbCrLf & ary(sampling)
    Next iTimes
End Sub

Sub WillNotRepeat()
   Dim ndex(1 To 10)
   For i = 1 To 10
      ndex(i) = i
   Next i

   Call Shuffle(ndex)

   For i = 1 To 3
      MsgBox i & vbCrLf & ary(ndex(i))
   Next i
End Sub

Sub Shuffle(InOut() As Variant)
    Dim HowMany As Long, i As Long, J As Long
    Dim tempF As Double, temp As Variant

    Hi = UBound(InOut)
    Low = LBound(InOut)
    ReDim Helper(Low To Hi) As Double
    Randomize

    For i = Low To Hi
        Helper(i) = Rnd
    Next i


    J = (Hi - Low + 1) \ 2
    Do While J > 0
        For i = Low To Hi - J
          If Helper(i) > Helper(i + J) Then
            tempF = Helper(i)
            Helper(i) = Helper(i + J)
            Helper(i + J) = tempF
            temp = InOut(i)
            InOut(i) = InOut(i + J)
            InOut(i + J) = temp
          End If
        Next i
        For i = Hi - J To Low Step -1
          If Helper(i) > Helper(i + J) Then
            tempF = Helper(i)
            Helper(i) = Helper(i + J)
            Helper(i + J) = tempF
            temp = InOut(i)
            InOut(i) = InOut(i + J)
            InOut(i + J) = temp
          End If
        Next i
        J = J \ 2
    Loop
End Sub

相关内容