hedef sütun değerni yazarken bir yandaki sütuna bakarak atama

Katılım
7 Mart 2025
Mesajlar
4
Excel Vers. ve Dili
excel vba
Kod:
Sub RastgeleKopyalaKurallarlaGelismis()
    Dim ws As Worksheet
    Dim veriAraligi As Range
    Dim hedefSutun As String
    Dim rastgeleSira As Collection
    Dim rastgeleIndex As Integer
    Dim sonSatir As Long
    Dim kullanilanSatirlar() As Boolean
    Dim secilenDeger As Variant
    Dim i As Long
    Dim gSayisi As Long
    Dim sonSutun As Long
    Dim sonSutunHarf As String
    Dim hedefSatir As Long
    Dim eDegeri As Variant
    
    ' Aktif çalışma sayfasını al
    Set ws = ActiveSheet
    
    ' Rastgele seçimler için başlat
    Randomize
    
    ' D sütunundaki son hücreyi bul
    sonSatir = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
    
    ' D3'ten son hücreye kadar olan aralığı belirle
    Set veriAraligi = ws.Range("D3:D" & sonSatir)
    
    ' Dizileri tanımla
    ReDim kullanilanSatirlar(1 To veriAraligi.Cells.Count)
    
    ' Son sütunu bul ve bir sağındaki sütunu belirle
    sonSutun = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column
    sonSutunHarf = Split(ws.Cells(1, sonSutun + 1).Address, "$")(1)
    
    ' Boş bir sütun bulana kadar devam et
    For i = 1 To 100
        If WorksheetFunction.CountA(ws.Columns(sonSutunHarf)) = 0 Then Exit For
        sonSutunHarf = Chr(Asc(sonSutunHarf) + 1)
    Next i
    
    hedefSutun = sonSutunHarf
    
    ' Rastgele seçilen hücreleri saklamak için bir koleksiyon oluştur
    Set rastgeleSira = New Collection
    
    ' G sütunundaki veri sayısını belirle
    gSayisi = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row - 2
    
    ' Rastgele seçimi başlat
    Do While rastgeleSira.Count < gSayisi
        rastgeleIndex = Int(Rnd * veriAraligi.Cells.Count) + 1
        

        
        ' Daha önce seçilmediyse işlem yap
        If Not kullanilanSatirlar(rastgeleIndex) Then
            ' Seçilen hücre değerini al
            secilenDeger = veriAraligi.Cells(rastgeleIndex).Value
            
            ' E sütunundaki değeri al
            eDegeri = veriAraligi.Cells(rastgeleIndex).Offset(0, 1).Value
            
            ' E değerine göre hedef satırı bul
            hedefSatir = 0
            For i = 3 To gSayisi + 2
                If ws.Cells(i, "F").Value <> eDegeri And ws.Cells(i, "G").Value <> eDegeri And ws.Cells(i, hedefSutun).Value = "" Then
                    hedefSatir = i
                    Exit For
                End If
            Next i
            
            ' Hedef satır bulunduysa kopyala
            If hedefSatir > 0 Then
                ws.Cells(hedefSatir, hedefSutun).Value = secilenDeger
                rastgeleSira.Add secilenDeger
                kullanilanSatirlar(rastgeleIndex) = True ' İşaretleme yaparak tekrar seçilmesini engelle
                
                ' Bir alt satıra da yerleştir (EK KONTROL: H sütunu değerine göre)
                If hedefSatir + 1 <= gSayisi + 2 Then
                    If ws.Cells(hedefSatir + 1, "F").Value <> eDegeri And ws.Cells(hedefSatir + 1, "G").Value <> eDegeri And _
                       ws.Cells(hedefSatir + 1, hedefSutun).Value = "" And _
                       ws.Cells(hedefSatir + 1, "H").Value = ws.Cells(hedefSatir, "H").Value Then
                          
                        ws.Cells(hedefSatir + 1, hedefSutun).Value = secilenDeger
                        rastgeleSira.Add secilenDeger
                        kullanilanSatirlar(rastgeleIndex) = True ' İşaretleme yaparak tekrar seçilmesini engelle
                    End If
                End If
            End If
        End If
    Loop
    
    ' Bir sonraki sütuna geç
    hedefSutun = Chr(Asc(hedefSutun) + 1)
    
End Sub
Böyle bir kodum var ama buna eklemek istediğim şey atama yapılcak hücredeki bulunan satırın h sütunundaki değeri pl ye eşit olduğu zaman son sütundaki değeri kopyalayıp aynısını atasın ki bu üç tane oluyor ve o değer diğer hücrelere atanmamalı örneğin h40 h41 ve h42 değeri pl ye eşit ve son sütun j40 j41 ve j42 x'e eşit o zaman k40 k41 ve k42 değerlerine de x atanıcak ama dinamik bir şekilde olsun istiyorum bu değerler sabitlenmemeli. Bir de atanan her rastgele değer son sütundaki satır değeri farklı olucak şekilde atansın yanı diyelim ki j4 'e m değeri atanmış o zaman m değeri k4'e de atanmıycak şekilde. Şimdiden teşekkürler.
 
Üst