Listboxta çoklu seçimin textbox1'de ve sonra da hücrede görünmesi

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Kolay gelsin arkadaşlar. Her ne kadar kendimi çok iyi görmesem de excelde kendimi en zayıf gördüğüm konu maalesef userform uygulamaları. Dosyamda C7:C aralığında bir hücreye tıkladığımda bir userform açılmasını ve bu userform üstünde bulunan listbox'a mahalleler sayfasından mahalle listesinin yüklenmesini sağladım (Gerçi kullandığım kod muhtemelen daha basitleştirilebilir).

Asıl yapmak istediklerim ise :
1 - Listboxta yaptığım seçimler anında textbox1'de görünsün. Eğer birden fazla seçim yapmışsam aralarında virgül ya da tire olsun.
2 - Aktar dediğimde textboxtaki veri seçili olan hücreye aktarılsın (muhtemelen bu zaten kodlar arasında mevcut)
3 - Commandbutton3 yani Seçim iptal düğmesine bastığımda seçilenler temizlensin ama userform açık kalsın.

Yardımcı olursanız çok sevinirim.

Dosya ekte, kullandığım kodlar da aşağıda:

Kod:
Private Sub UserForm_Initialize()
    Dim a      As Long
    Dim i      As Long
    ReDim dizial(1 To 56, 1 To 1)


    ListBox1.ColumnCount = 1
    ListBox1.MultiSelect = fmMultiSelectMulti

    For i = 2 To Sheets("Mahalleler").Cells(Rows.Count, "A").End(3).Row
            a = a + 1
            ReDim Preserve dizial(1 To 56, 1 To a)
            dizial(1, a) = Sheets("Mahalleler").Cells(i, "A")
    Next i

        ListBox1.Column = dizial
    Erase dizial
    a = Empty
    i = Empty
    Set SV = Nothing
    
End Sub
Private Sub CommandButton1_Click()
    
    ActiveCell.Value = TextBox1.Value
    Unload Me

End Sub

Private Sub CommandButton3_Click()
'Burada mümkünse listeden seçim yapılmışsa seçimin iptal edilmesini istiyorum (seçilenleri seçme/hiçbir şey seçme yani)
End Sub

Private Sub CommandButton2_Click()
Unload UserForm2
End Sub
Yardımlarınız için şimdiden teşekkür ederim.
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Ayrıca aynı dosyada yapmak istediğim ikinci işlem de şudur:

Tablo sayfasındaki a yılı ve ayı verilerini getir düğmeye bastığımda ana sayfada bulunan verilerin ay ve yılına göre tablo sayfasına listelenmesini istiyorum. Bunu elbette for next döngüsüyle yapabilirim. Ancak bu veri çokluğuna göre biraz uzun sürebilir. Bunun yerine sayın ziynettin'in kullandığı dizi yöntemini kullanmak istiyorum.

Sayın ziynettin'in başka bir konuda kullandığı kodları kendime uyarlamaya çalıştım ama başarılı olamadım maalesef. Kodlar aşağıda:

Kod:
Sub ayyükle()
Dim yıl As Integer, ay As String
Set s1 = Sheets("Ana Sayfa")
Set s2 = Sheets("Tablo")
Set d = CreateObject("scripting.dictionary")

a = s1.Range("A7:K" & s1.Cells(Rows.Count, "A").End(3).Row)
yıl = s2.[G4]
ay = s2.[I4]

eski = WorksheetFunction.Max(7, s2.Cells(Rows.Count, "A").End(3).Row)
[c4] = eski
If eski > 7 Then
    s2.Range("A" & eski - 7 & ":I" & eski).Select
    s2.Range("A" & eski - 7 & ":I" & eski).Clear
End If
For i = 1 To UBound(a)
    If a(i, 10) = yıl And a(i, 11) = ay Then
        krt = a(i, 1)
        If d.exists(krt) Then
  '          If a(i, 7) > a(d(krt), 7) Then
  '              d(krt) = i
  '          End If
  '      Else
            d(krt) = i
        End If
    End If
Next i

If d.Count > 0 Then
    Application.ScreenUpdating = False
    s2.Range("A7:K" & Rows.Count).Clear
    ReDim b(1 To d.Count, 1 To UBound(a, 2))
    For Each v In d.keys
        say = say + 1
        b(say, 1) = v
        For Y = 2 To UBound(a, 2)
            b(say, Y) = a(d(v), Y)
        Next Y
    Next v
    's2.[G5].Resize(say, 3).NumberFormat = "dd.mm.yyyy"
    's2.[E5].Resize(say).NumberFormat = "@"
    's2.[A5].Resize(say, UBound(a, 2)) = b
    Application.ScreenUpdating = True
    MsgBox "İşlem tamam.", vbInformation
Else
    MsgBox "Sonuç bulunamadı.", vbCritical
End If
End Sub
Bu işlemi dizi yöntemiyle halledebilir miyiz?
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,596
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Merhaba Yusuf Bey,

Listbox seçimleri ve Textbox'ta yer alması ile ilgili olarak aşağıdaki kodu kullanabilirsiniz.
Veriyi hücrelere almayı siz yaparsınız.


Kod:
Private Sub ListBox1_Change()

TextBox1.Value = ""
For i = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(i) = True Then
 alan = alan & ListBox1.List(i, 0) & "-"
End If
Next i
If alan <> Empty Then
alan = VBA.Left(alan, VBA.Len(alan) - 1)
TextBox1.Value = alan
End If
End Sub
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,596
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Formları temizlemek için aşağıdaki kodu fikir vermesi için ekliyorum.
Daha kesin çözüm için class yazılabilir. Formda çok nesne yoksa class'a gerek yok, aşağıdaki gibi yapılabilir.

Kod:
Private Sub CommandButton2_Click()
Dim txt As Control
For Each txt In Me.Controls
If TypeName(txt) = "TextBox" Then txt.Value = ""
Next
ComboBox1.Value = ""
TextBox3.Value = ""
OptionButton2.Value = False
OptionButton3.Value = False
End Sub
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,596
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Yusuf bey,

Veri getirmek için aşağıdaki kodu kullanabilirsiniz.
Scripting.Dictionary yerine ADO nesnesini kullanmanızı öneririm.
Kodlaması daha kolay ve rahattır. Ayrıca kapalı dosyalarda da kullanabilirsiniz.
Excel'de veri işlemleri yapmak istiyorsanız kesinlikle ADO'yu öğrenin.
SQL yazmaya başlamak için http://www.sqlkodlari.com/ sitesini öneririm.

Kod:
Sub getir()

Range("b7:I44").ClearContents

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

sorgu = "select f2,f3,f4,f5,f6,f7,f8,f9 from[ana sayfa$A7:K10000] where f10 = " & Range("G4") & " and f11 = '" & Range("I4") & "' "
Set rs = con.Execute(sorgu)

Range("b7").CopyFromRecordset rs

End Sub
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Sayın Erdem_34, çok çok teşekkür ederim. Verilerin textboxta görünmesini verdiğiniz kodu aşağıdaki gibi düzenleyince halletim sayenizde:

Kod:
Private Sub ListBox1_Change()
TextBox1.MultiLine = True
TextBox1.WordWrap = True
TextBox1.Value = ""

For i = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(i) = True Then
        alan = alan & ListBox1.List(i, 0) & "-"
    End If
Next i

If alan <> Empty Then
    alan = VBA.Left(alan, VBA.Len(alan) - 1)
    TextBox1.Value = alan
End If
End Sub
Yine gösterdiğiniz yol ile seçililerin silinmesini/seçimin iptal edilmesini aşağıdaki kodla hallettim sayenizde:

Kod:
Private Sub CommandButton3_Click()
Dim txt As Control
For Each txt In Me.Controls
If TypeName(txt) = "TextBox" Then txt.Value = ""
Next
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
        ListBox1.Selected(i) = False
    End If
Next i
End Sub
Verilerin seçili hücreye aktarılması zaten basitti:

Kod:
Private Sub CommandButton1_Click()
    ActiveCell.Value = TextBox1.Value
    Unload Me
End Sub
Böylelikle ilk sorduğum soruları sayenizde çözmüş oldum. Teşekkür ederim.

Ancak sorgu işlemini yapamadım maalesef. Verdiğiniz kodu aşağıdaki şekilde düzenledim:
Kod:
Sub getir()
Dim yıl As Integer, ay As String
Set s1 = Sheets("Ana Sayfa")
Set s2 = Sheets("Tablo")
yıl = s2.[G4]
ay = s2.[I4]
veri = WorksheetFunction.Max(7, s1.Cells(Rows.Count, "A").End(3).Row)
eski = WorksheetFunction.Max(7, s2.Cells(Rows.Count, "A").End(3).Row)

If eski > 7 Then
    s2.Range("A" & eski - 7 & ":I" & eski).Select
    s2.Range("A" & eski - 7 & ":I" & eski).Clear
End If

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

sorgu = "select f1, f2,f3,f4,f5,f6,f7,f8,f9 from[ana sayfa$A7:K100000] where f10 = " & yıl & " and f11 = '" & ay & "' "
Set rs = con.Execute(sorgu)

Range("A7").CopyFromRecordset rs

End Sub
Burada "from[ana sayfa$A7:K100000] kaynağını bulamadım" şeklinde bir hata veriyor. Bir hata mı var?
 
Son düzenleme:

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,596
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Yusuf bey merhaba,

Yeni kullanıcı adımla ilk mesajımı size yazıyorum. (Eski kullanıcı adım kuvari)

Eklediğiniz dosyaya göre kod bende çalışmıştı.
Hata veren dosyanızdaki alanlar ile eklediğiniz dosya ile farklı olabilir.
[ana sayfa$A7:K100000] verilerin başladığı alan başlıklar hariç.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Ben de önce kuvari diye görüp, teşekkür etmiştim. Sonra birden erdem oluverdi şaşırdım.

Kodları gönderdiğim dosya üzerinde kullanacağım. Zaten asıl dosyam bu, yani örnek vs değil. Tekrar son halini yüklüyorum. İncelerseniz sevinirim:
 

Ekli dosyalar

Son düzenleme:

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,596
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Merhaba,

[ana sayfa$A7:K100000] bu alanı 10000 yaparsanız hata düzelir.

Anasayfa tablosundaki ilk 6 satırı silebilirseniz kod yazma açısından daha rahat olur.
O zaman [ana sayfa$] şeklinde yazabilirsiniz.

Ayrıca Listbox'ta seçtiklerinizi sonuç olarak başka bir listbox'ta göstermeniz kodlama ve form'da görüntüleme açısından daha kullanışlı olacaktır.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Teşekkürler sayın Erdem_34. Belirttiğiniz gibi 10000 yapınca düzeldi.

Bu şu anlama mı geliyor: "bu sorgu 10000 satırdan sonra çalışmaz/verimli olmaz"

Dosya bu haliyle bayağı verimli hatta tam istediğim gibi oldu diyebilirim. Yalnız dikkatimi bir şey çekti. Makro çalıştıktan sonra Ana sayfada F, G, H sütunlarındaki saatler tarih+saat biçimine dönüşüyor.
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,596
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Teşekkürler sayın Erdem_34. Belirttiğiniz gibi 10000 yapınca düzeldi.

Bu şu anlama mı geliyor: "bu sorgu 10000 satırdan sonra çalışmaz/verimli olmaz"

Dosya bu haliyle bayağı verimli hatta tam istediğim gibi oldu diyebilirim. Yalnız dikkatimi bir şey çekti. Makro çalıştıktan sonra Ana sayfada F, G, H sütunlarındaki saatler tarih+saat biçimine dönüşüyor.
Merhaba,

Aslında 1.000.000 satır'da bile çalışabilir. Direkt alanı kendiniz belirlediğinizde kabul etmiyor.
Saati sorgunun içinde format işlemini kullanarak biçimlendirebilirsiniz.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Önerinizle ana sayfayı daha düzenli yaptım. Yardımlarınız için çok teşekkür ederim.

Saat olayını zaten format koduyla halletmiştim ama takıldığım nokta, makroda Ana sayfada yapılan bir işlem olmadığı halde neden biçiminin bozulduğu.
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,596
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Yusuf bey,

Sorguyu aşağıdaki gibi yaparsanız istediğiniz formatta veriyi alabilirsiniz.

Kod:
sorgu = "select f2,f3,f4,f5, Format(f6,'hh:mm') ,format(f7,'hh:mm'),format(f8,'hh:mm'),f9 from[ana sayfa$] where f10 = " & Range("G4") & " and f11 = '" & Range("I4") & "' "
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,596
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Clear yerine ClearContents kullanırsanız , hücrelerdeki biçimlendirmeler silinmez. Sizin dosyanızda denemedim.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aslında veri almada problem yok. Zaten sonuç yani tablo sayfasında tüm verileri baştan biçimlendiriyorum makro ile. Sorun kaynak verinin biçiminin değişmesi. Halbuki kaynak veride sadece sorgulama yapıyoruz.

Ana sayfada veriler ss:dd formatındayken makro çalıştıktan sonra ana sayfadaki veriler gg.aa.yyyy ss:dd formatına dönüşüyor.

Bu sorunu sayfa activate kodu ile düzeltiyorum ama neden bozulduğunu anlamıyorum.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Clear olarak özellikle kullanıyorum . Çünkü listelenecek veriler 1 de olabilir 31 de (teorik olarak 31’den fazla olmamalı, her gün için bir veri olmalı). Bu verilerin iki satır altına da başka bir sayfadan veri kopyalayıp yapıştırıyorum onay mahiyetinde.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba Yusuf Bey,

Formunuzun veri yükleme bölümünü aşağıdaki gibi kısaltabilirsiniz.

Kod:
Private Sub UserForm_Initialize()
    ListBox1.ColumnCount = 1
    ListBox1.MultiSelect = fmMultiSelectMulti
    With Sheets("Temel Veriler")
        ListBox1.List = Application.Transpose(.Range("A2:A" & .Cells(Rows.Count, 1).End(3).Row))
    End With
End Sub
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Çok teşekkürler Korhan Bey.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Sayın Erdem34, sorguya süre kriterini de eklemek istedim ancak hata veriyor. Günlük en az 5 saat süreli işlem yapıldığında tablo sayfasına aktarılması lazım. Bunun için farklı yöntemlerle kodu düzenlemeye çalıştım. 05:00'ın karşılığı 5/24 olduğu için kodu

sorgu = "select f2,f3,f4,f5,f6,f7,f8,f9 from[Ana Sayfa$] where f10 = " & yıl & " and f11 = '" & ay & "' and f8 >= " & 5/24 & ""

olarak ve

sorgu = "select f2,f3,f4,f5,f6,f7,f8,f9 from[Ana Sayfa$] where f10 = " & yıl & " and f11 = '" & ay & "' and f8 >= " & 05:00 & ""

olarak ve başka yerde sure adlı bir değişken belirleyip

sorgu = "select f2,f3,f4,f5,f6,f7,f8,f9 from[Ana Sayfa$] where f10 = " & yıl & " and f11 = '" & ay & "' and f8 >= " & sure & ""

olarak düzenledim ama "virgül hatası" şeklinde hata veriyor.

f8 için 05:00'a büyük eşit olanları aktar nasıl diyebiliriz?

(Olmazsa ana sayfaya bir sütun daha ekleyip olumlu/olumsuz ya da 1/0 şeklinde formül de yapabilirim, önceliğim kodun doğrusunu öğrenip uygulamak)
 
Üst