Listboxtan birden fazla veriyi aynı hücreye yazdırma ve Diğer Değer Kutusu

[MyMamoste]

İyi günler ustadlar. Sorularım bir yardım kuruluşuna gönüllü olarak program yapma isteğimden kaynaklıdır. Hayır işi sizin de yardımınızı bekliyorum.

1. Sorum
Elimde bir veri var, Veri Sayfası diye bir sayfa ve DB diye verilerin çekildiği bir diğer sayfa var. DB sayfasından kategori ismine göre veri çekiyorum. Veri Sayfasında ilgili hücrelerde çift tıklayınca kategori ismine göre DB sayfasından Listbox tablosunda veriler çekiliyor ve Listboxta çıkan seçeneklere tıklayıp kaydet butonuna basınca, hangi hücrede çift tıklayıp bu listboxa ulaşmışsam o hücreye seçtiğim değer yerleşiyor.

Buraya kadar sıkıntı yok. Benim yapmak istediğim birden fazla seçeneği seçtiğimde multiselect ile seçtiğim bütün değerler o tıklanan hücre hangisi ise araya virgül veya tire yazılarak o hücreye yerleşsin.

Yaptığım aramalarda hep belli hücre adresi yazılmış ben belli hücre adresi değil tıklanan hücre hangisi ise oraya yazsın istiyorum. Örneğin C12 hücresinde çift tıklayıp Listboxa ulaşınca listboxta seçtiğim 3 4 değer artık kaç değer seçeceksem hepsi araya virgül konularak C12 hücresine yazılsın.

2. Sorum Listbox listesine Diğerleri diye bir seçenek yazıp, o seçeneğe tıklayınca karşıma elle yazı yazabileceğim bir kutucuk çıksın ki farklı bir şey varsa onu da hücreye aktarayım.

Bu Veri Sayfası adındaki sayfanın kodları....

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Row < 2 Or Target.Column < 4 Or Target.Column > 12 Then
Exit Sub
Else
hucre = Target.Address

End If

kolon = Mid(hucre, 2, 1)            'Sütun Harfini verir
satir = Target.Row                  'Satır sayısını verir
baslik = kolon & 1                  'Sütun ve satırı birleştirir örneğin A5 gibi
kriter = Range("" & baslik & "")    'Veri tabanında yer alan başlık ile tablodaki başlığı alır

Dim baglanti As New ADODB.Connection
Dim rs As New ADODB.Recordset
yol = Application.ThisWorkbook.FullName 'Bu çalışma kitabı demek
baglanti.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
yol & ";extended properties=""Excel 12.0;hdr=yes"""

If kolon = "E" Then
sorgu = "select Distinct(" & "[" & kriter & "]" & ") from [DB$]"
rs.Open sorgu, baglanti, adOpenKeyset, adLockOptimistic

ElseIf kolon = "F" Then
sorgu = "select Distinct(" & "[" & kriter & "]" & ") from [DB$]"
rs.Open sorgu, baglanti, adOpenKeyset, adLockOptimistic

ElseIf kolon = "D" Then

sorgu = "select Distinct(" & "[" & kriter & "]" & ") from [DB$]"
rs.Open sorgu, baglanti, adOpenKeyset, adLockOptimistic

ElseIf kolon = "G" Then

sorgu = "select Distinct(" & "[" & kriter & "]" & ") from [DB$]"
rs.Open sorgu, baglanti, adOpenKeyset, adLockOptimistic

ElseIf kolon = "H" Then

sorgu = "select Distinct(" & "[" & kriter & "]" & ") from [DB$]"
rs.Open sorgu, baglanti, adOpenKeyset, adLockOptimistic

ElseIf kolon = "I" Then

sorgu = "select Distinct(" & "[" & kriter & "]" & ") from [DB$]"
rs.Open sorgu, baglanti, adOpenKeyset, adLockOptimistic

ElseIf kolon = "J" Then

sorgu = "select Distinct(" & "[" & kriter & "]" & ") from [DB$]"
rs.Open sorgu, baglanti, adOpenKeyset, adLockOptimistic

ElseIf kolon = "K" Then

sorgu = "select Distinct(" & "[" & kriter & "]" & ") from [DB$]"
rs.Open sorgu, baglanti, adOpenKeyset, adLockOptimistic

ElseIf kolon = "L" Then

sorgu = "select Distinct(" & "[" & kriter & "]" & ") from [DB$]"
rs.Open sorgu, baglanti, adOpenKeyset, adLockOptimistic
End If


With UserForm1.ListBox1
.Column = rs.GetRows
End With

rs.Close
baglanti.Close

UserForm1.TextBox1 = Target.Row
UserForm1.TextBox2 = Target.Column
UserForm1.Show
End Sub

Bu da Commandbuton Kaydet butonun kodları

Private Sub CommandButton1_Click()
Cells(Me.TextBox1, Me.TextBox2) = Me.ListBox1
Unload Me

End Sub