• FORUMU MOBİL UYGULAMADAN TAKİP EDİN

    Forumu isteyen üyelerimiz Tapatalk (Harici bir hizmet) üzerinden mobil uygulamadan takip edebilirler.
    iOS için : https://itunes.apple.com/app/id307880732?mt=8
    Android için : https://play.google.com/store/apps/details?id=com.quoord.tapatalkpro.activity
    adreslerinden indirebilirsiniz.

    Bir iki haftaya da foruma özel kendi uygulamamız yayında olacak.
ALTIN ÜYELİK Hakkında Bilgi
-----------------------

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
6,889
Beğeniler
45
Excel Vers. ve Dili
İş : Ofis 2016 - Türkçe
Ev: Ofis 2016 - Türkçe
#1
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
6,889
Beğeniler
45
Excel Vers. ve Dili
İş : Ofis 2016 - Türkçe
Ev: Ofis 2016 - Türkçe
#2
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_34

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
2,836
Beğeniler
23
Excel Vers. ve Dili
OFİS 2013 TÜRKÇE-İNG. 64 BİT
#3
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_34

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
2,836
Beğeniler
23
Excel Vers. ve Dili
OFİS 2013 TÜRKÇE-İNG. 64 BİT
#4
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_34

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
2,836
Beğeniler
23
Excel Vers. ve Dili
OFİS 2013 TÜRKÇE-İNG. 64 BİT
#5
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
6,889
Beğeniler
45
Excel Vers. ve Dili
İş : Ofis 2016 - Türkçe
Ev: Ofis 2016 - Türkçe
#6
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_34

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
2,836
Beğeniler
23
Excel Vers. ve Dili
OFİS 2013 TÜRKÇE-İNG. 64 BİT
#7
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
6,889
Beğeniler
45
Excel Vers. ve Dili
İş : Ofis 2016 - Türkçe
Ev: Ofis 2016 - Türkçe
#8
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_34

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
2,836
Beğeniler
23
Excel Vers. ve Dili
OFİS 2013 TÜRKÇE-İNG. 64 BİT
#9
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
6,889
Beğeniler
45
Excel Vers. ve Dili
İş : Ofis 2016 - Türkçe
Ev: Ofis 2016 - Türkçe
#10
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_34

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
2,836
Beğeniler
23
Excel Vers. ve Dili
OFİS 2013 TÜRKÇE-İNG. 64 BİT
#11
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
6,889
Beğeniler
45
Excel Vers. ve Dili
İş : Ofis 2016 - Türkçe
Ev: Ofis 2016 - Türkçe
#13
Ö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_34

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
2,836
Beğeniler
23
Excel Vers. ve Dili
OFİS 2013 TÜRKÇE-İNG. 64 BİT
#14
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_34

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
2,836
Beğeniler
23
Excel Vers. ve Dili
OFİS 2013 TÜRKÇE-İNG. 64 BİT
#15
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
6,889
Beğeniler
45
Excel Vers. ve Dili
İş : Ofis 2016 - Türkçe
Ev: Ofis 2016 - Türkçe
#16
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
6,889
Beğeniler
45
Excel Vers. ve Dili
İş : Ofis 2016 - Türkçe
Ev: Ofis 2016 - Türkçe
#17
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

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
23,577
Beğeniler
74
Excel Vers. ve Dili
OFFICE 2013-2016 PRO TR
#18
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
6,889
Beğeniler
45
Excel Vers. ve Dili
İş : Ofis 2016 - Türkçe
Ev: Ofis 2016 - Türkçe
#20
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