+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Excel Makro (soru) (/konu-excel-makro-soru.html)
Sayfalar:
1
2
RE: Excel Makro (soru) - haandsomee_tr - 10/06/2024
(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
RE: Excel Makro (soru) - berduş - 10/06/2024
eklediğiniz örnekte benzersizdi o nedenle sordum
RE: Excel Makro (soru) - haandsomee_tr - 10/06/2024
(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.
RE: Excel Makro (soru) - berduş - 10/06/2024
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ı?
RE: Excel Makro (soru) - berduş - 10/06/2024
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