☰

¿Cómo agrego un comando para omitir duplicados?

tag-icon • tag-icon microsoft-excel
¿Cómo agrego un comando para omitir duplicados?

Tengo la siguiente macro. Lo estoy usando para tomar muestras de filas, pero quiero editarlo para omitir filas que ya han sido seleccionadas. ¿Alguien puede proporcionar una solución?

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

Respuesta1

En tu código generas un índice aleatorio con:

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

esto funciona, pero permite repeticiones aleatorias. Otra forma es

  • crear una matriz fija de índices
  • barajar los índices
  • utilizar los índices

Esto asegura que no se repita(porque no hay repeticiones en los índices)

A continuación se muestra un ejemplo de ambos tipos de muestreo aleatorio:

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

información relacionada