Soru Listbox tan sayfadaki hücreye değer yollama

[yasarcan]

Yusuf beyin düzenlemiş olduğu L1den L2 ye oradan da L3 e Listbox u çalıştırabiliyorum. Ancak L3 de Multiselect te seçtiğim veriyi istediğim bir sayfanın hücresine evet hayır yada "a","" yazdırmaya çalıştım başaramadım.

örnek 1 üzerinde çalışarak iyice bozduğum ana uygulamam
örnek 2 tek listboxta ve tam istediğim gibi çalışan listbox (sayfa1 istediğim şekilde düzenlenmiştir)
örnek 3 listbox açılınca seçimlerimi örnekteki gibi işaretli açmasını sağlayamadım.

Teşekkür ederim

 

[Korhan Ayhan]

Ana dosyanızda sayfa ismi ile kod tarafındaki sayfa ismi örtüşmüyor.

SAYFA1 <> Sheets("ÇEKLİST")

Kodlarda ADO kullanılmış. ADO uygulamaları genellikle veritabanı için kullanılmaktadır. Tablonuzun veritabanı mantığında olması size her zaman avantaj sağlar. Fakat sizin ana dosyanızda ilk 4 satır boş sonrasında veriler başlıyor. Bunlar soruna sebep olacak durumlardır. Bunlara dikkat etmelisiniz.

 

[yasarcan]

Teşekkür ederim.
Kodları ordan burdan bulup yapıştırdığım için ve sayfalarıda sürekli düzenlediğim için sağlam olan da bozuluyor arada
şu çalışan kodla:

Private Sub L1_Change()
If L2.ListCount > 0 Then
    For i = 0 To L2.ListCount - 1
        If L2.List(i) = L1.Value Then
            GoTo 10
        End If
    Next
End If
L2.AddItem L1.Value
10:
End Sub

Private Sub L2_Change()
Set s1 = Sheets("ÇEKLİST")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
L3.Clear
For i = 0 To L2.ListCount - 1
    If L2.Selected(i) Then
        sorgu = "select distinct İÇERİK from [ÇEKLİST$] where KONU='" & L2.List(i) & "'"
        Set rs = con.Execute(sorgu)
        L3.Column = rs.getrows
    End If
Next
End Sub


Private Sub UserForm_Initialize()
Dim oWs    As Worksheet
    For Each oWs In Sheets
Set s1 = Sheets("ÇEKLİST")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").End(3).Row)
Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
sorgu = "select distinct KONU from [ÇEKLİST$] where KONU is not null"
Set rs = con.Execute(sorgu)
L1.Column = rs.getrows
 'L3.RowSource = "ÇEKLİST!D2:D55555"
        If oWs.Type = 3 Then    'Chart sheet
            Me.lbxSheets.AddItem oWs.Name
            'exclude empty sheets
        ElseIf WorksheetFunction.CountA(oWs.Cells) > 0 Then
            Me.lbxSheets.AddItem oWs.Name
        End If
    Next oWs
End Sub

başka bir projede çalışan ve asıl istediğim de bu: L3 listboxunda tıklama yapıp seçtiğimde ÇEKLİST sayfasında D sütununa ilgili satırında x yazdırabilirmiyim. alttaki kod ile üstekini birleştireceğim

Private Sub L3_Change()
Dim rng As Range
Set rng = Range(L3.RowSource).Cells(1, 1)
Application.Calculation = xlCalculationManual
With rng
For i = 0 To L3.ListCount - 1
If ListBox1.Selected(i) Then
.Offset(i, 1) = "x"
Else
.Offset(i, 1) = ""
End If
Next i
End With
Application.Calculation = xlCalculationAutomatic
End Sub

çok uğraştım çalıştıramadım.
Ve dahası bu kodlama adımlarını anlatan bir kaynak lazım. Tekniğimi geliştirmem gerek.
Teşekkür ederim