ListBox'a göre OptionButton

[mami38]

selamün aleyküm,

ListBox ile A hücresini benzersiz olarak süzüp, D hücresinde ki değere göre OptionButton'ları aktif etmek istiyorum. Aynı isimlerin D hücresinde ki değerleri aynı olacak. Mesela 5tane ahmet var ise 5ide Evet yada 5ide Hayır olucak o yüzden benzersiz süzmek istiyorum.

Örneğin,

Ahmet'e tıkladık eğer D hücresi Evet ise OptionButton Evet işaretlenicek.

2.Sorum ise Userform üzerinden yeni kayıt yaparken UserForm'a göre nasıl değer girerim.

Teşekkürler.

 

[Orion1]

Biraz çelişkili gibi geldi bana ama ekli dosyada bir şeyler yaptım,1nci şıkkınız için.
Dosyanız ektedir.

Private Sub OptionButton1_Click()
Dim z As Object, deg As String, liste, i As Long
ListBox1.Clear
Set z = CreateObject("scripting.dictionary")
liste = Range("A2:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value
If OptionButton1.Value = True Then
    For i = 1 To UBound(liste)
        If liste(i, 4) = "evet" Then
            If Not z.exists(liste(i, 1)) Then
                z.Add liste(i, 1), Nothing
            End If
        End If
    Next i
End If
If z.Count > 0 Then ListBox1.List = Application.Transpose(Array(z.keys))
End Sub

Private Sub OptionButton2_Click()
Dim z As Object, deg As String, liste, i As Long
ListBox1.Clear
Set z = CreateObject("scripting.dictionary")
liste = Range("A2:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value
If OptionButton2.Value = True Then
    For i = 1 To UBound(liste)
        If liste(i, 4) = "hayır" Then
            If Not z.exists(liste(i, 1)) Then
                z.Add liste(i, 1), Nothing
            End If
        End If
    Next i
End If
If z.Count > 0 Then ListBox1.List = Application.Transpose(Array(z.keys))

End Sub

 

[mami38]

ilginiz için teşekkürler ederim fakat tam tersi olucaktı

Listboxta A hücresinde ki veriler benzersiz olarak gözüküp, Veriye tıkladığımızda D hücresinde ki değer Evet ise Evet işaretli, Hayır ise Hayır işaretli olabilir mi.

 

[Orion1]

ilginiz için teşekkürler ederim fakat tam tersi olucaktı

Listboxta A hücresinde ki veriler benzersiz olarak gözüküp, Veriye tıkladığımızda D hücresinde ki değer Evet ise Evet işaretli, Hayır ise Hayır işaretli olabilir mi.

Ekteki dosyadaki gibimi?

Option Base 1

Private Sub ListBox1_Click()
If ListBox1.Column(3) = "evet" Then
    OptionButton1.Value = True
ElseIf ListBox1.Column(3) = "hayır" Then
    OptionButton2.Value = True
End If

End Sub

Private Sub UserForm_Initialize()
Dim z As Object, liste, i As Long, n As Long, myarr
Set z = CreateObject("scripting.dictionary")
liste = Range("A2:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value
ReDim myarr(1 To 4, 1 To UBound(liste))
For i = 1 To UBound(liste)
    If Not z.exists(liste(i, 1)) Then
        n = n + 1
        z.Add liste(i, 1), n
        myarr(1, n) = liste(i, 1)
        myarr(2, n) = liste(i, 2)
        myarr(3, n) = liste(i, 3)
        myarr(4, n) = liste(i, 4)
    End If
Next i
Erase liste
If z.Count > 0 Then ListBox1.Column = myarr
Erase myarr
Set z = Nothing
End Sub

 

[mami38]

Evet bu şekilde, bir şey daha sorucam zahmet olmazsa size

Şimdi 4tane benzersiz veri olduğu için ;

myarr(1, n) = liste(i, 1)
myarr(2, n) = liste(i, 2)
myarr(3, n) = liste(i, 3)
myarr(4, n) = liste(i, 4)

yazmışsınız, bneim asıl dosyamda 200-300tane veri olucak. Daha kısa yoldan yapma şansım olabilir mi

 

[vardar07]

Evet bu şekilde, bir şey daha sorucam zahmet olmazsa size

Şimdi 4tane benzersiz veri olduğu için ;

myarr(1, n) = liste(i, 1)
myarr(2, n) = liste(i, 2)
myarr(3, n) = liste(i, 3)
myarr(4, n) = liste(i, 4)

yazmışsınız, bneim asıl dosyamda 200-300tane veri olucak. Daha kısa yoldan yapma şansım olabilir mi

Demiş olduğunuz 4tane benzersiz veri değil sütun sayısıdır.
Veri sayısı:

liste = Range("A2:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value

satırıdır.

 

[Orion1]

Evet bu şekilde, bir şey daha sorucam zahmet olmazsa size

Şimdi 4tane benzersiz veri olduğu için ;

myarr(1, n) = liste(i, 1)
myarr(2, n) = liste(i, 2)
myarr(3, n) = liste(i, 3)
myarr(4, n) = liste(i, 4)

yazmışsınız, bneim asıl dosyamda 200-300tane veri olucak. Daha kısa yoldan yapma şansım olabilir mi

Onlar 4 tane benzersiz veri olduğu için değil 4 tane sütun olduğu için varlar.
Sizin ayrıyetten kod yazmanıza gerek yok.Bu kodlar işinizi görür.
Ben kodları dosyayı indirmek istemeyenler için yada indiremeyenler için buraya yazıyorum.

 

[mami38]

Maalesef kendi dosyama göre uyarlayamadım kodları

Ayrıntılı şekilde kodların işlemlerini anlatma şansınız var mı, çok oldum biliyorum