Skip to main content

AccessTr.neT


Excel Makro (soru)

haandsomee_tr
haandsomee_tr
10
195

Excel Makro (soru)

#7
(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
Cevapla
#8
eklediğiniz örnekte benzersizdi o nedenle sordum
Cevapla
#9
(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.
Cevapla
#10
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ı?
Cevapla
#11
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
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da