Excel Makro (soru)

(10/06/2024, 16:06)berduş yazdı: c sütunundaki veriler zaten benzersiz değil mi?

hayır hocam o yüzden duplicate olayıda önemli oluyor

eklediğiniz örnekte benzersizdi o nedenle sordum

(10/06/2024, 16:18)berduş yazdı: eklediğiniz örnekte benzersizdi o nedenle sordum

haklısın hocam oraya benzersiz koymuşum. Kod içerisinde duplicate olduğu için o tarafa aynı kayıtları tekrar etmeyi unutmuşum.

peki diyelim ki seçtiğiniz bölge 20 satır ama c sütunundaki tekrarlı veriler nedeniyle benzersiz satır sayısının 10un altına düşme ihtimali var mı?

dilerim işinize yarar
Not: bir önceki mesajımda yer alan olasılık göz ardı edilmiştir

Sub SecmeliRastGele_2()

Set Rng = ThisWorkbook.Worksheets("ALL_DATA").Range("A1:C10000").SpecialCells(xlCellTypeVisible)



 Dim DataArray() As Variant



       rowCount = WorksheetFunction.CountA(Rng) / Rng.Columns.Count

    If rowCount <= 10 Then

        ThisWorkbook.Worksheets("ALL_DATA").Range("A1:C10000").SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWorkbook.Worksheets("HedefSayfa").Range("A1")

        Exit Sub

    End If

    Dim dzSecil As Variant

    ReDim dzSecil(1 To rowCount)

   

     i = 0

    For Each xRw In Rng.Rows

    i = i + 1

        dzSecil(i) = xRw.Value

        If rowCount = i Then GoTo 10

    Next xRw

10

Dim dctIndx As Object: Set dctIndx = CreateObject("Scripting.Dictionary")

    Do While dctIndx.Count < 10

    Randomize

    TmpTrh = Int((rowCount - 2 + 1) * Rnd + 2) '    Int((UstSnr - AltSnr + 1) * Rnd + AltSnr)

    If dctIndx.Exists(TmpTrh) Then GoTo 20

    CDeger = dzSecil(TmpTrh)(1, 3)

        For i = 0 To dctIndx.Count - 1

            If CDeger = dzSecil(dctIndx.Keys()(i))(1, 3) Then GoTo 20

        Next i

    dctIndx.Add TmpTrh, 0

20

    Loop

 

   Dim dzTmp() As Variant

 ReDim dzTmp(0 To dctIndx.Count, 2)

 x = 0

        dzTmp(x, 0) = dzSecil(1)(1, 1)

        dzTmp(x, 1) = dzSecil(1)(1, 2)

        dzTmp(x, 2) = dzSecil(1)(1, 3)

 For Each ky In dctIndx.Keys

 x = x + 1

        dzTmp(x, 0) = dzSecil(ky)(1, 1)

        dzTmp(x, 1) = dzSecil(ky)(1, 2)

        dzTmp(x, 2) = dzSecil(ky)(1, 3)

 Next

ThisWorkbook.Worksheets("HedefSayfa").Range("A1").Resize(UBound(dzTmp) + 1, 3) = dzTmp



End Sub