Listbox'a Veri Listeleme

ahmed_ummu · 5 Nisan 2024

Merhaba arkadaşlar.

"ÜP" sayfasında "BI" ve "BK" sütunlarında listelerim var. Bu iki listeyi karşılaştırıp, BI sütununda olupta, BK sütununda olmayan verileri listbox5'e listeleyecek. Aşağıdaki kodda kırmızı renkli ve altı çizili satırı seçip, "Permission denied" hatası veriyor. Hata nerededir. Yardımcı olabilir misiniz.

For i = 2 To Worksheets("üp").Cells(Rows.Count, 1).End(3).Row
If Worksheets("üp").Cells(i, 1).Value <> Worksheets("üp").Cells(i, 3).Value Then
ListBox5.AddItem Worksheets("üp").Cells(i, 1).Value
End If
Next

Zeki Gürsoy · 5 Nisan 2024

Merhaba;

Kırmızı satırda "Permission denied" mesajı verecek bir durum görünmüyor. Kodların tamamını paylaşır mısınız? (Bazen VBE, alakasız bir satırı boyayabiliyor. Bilginiz olsun... )

.

ahmed_ummu · 5 Nisan 2024

Zeki Gürsoy' Alıntı:
Merhaba;

Kırmızı satırda "Permission denied" mesajı verecek bir durum görünmüyor. Kodların tamamını paylaşır mısınız? (Bazen VBE, alakasız bir satırı boyayabiliyor. Bilginiz olsun... )

.

Kodların hepsi aşağıda.

Bu kod ile BI sütunu seçiliyor.
Set s = Sheets("ÜP")
s.Select
aranan = ComboBox12.Value '(Combobox12 'deki değere göre)
Cells.Find(aranan).Select
ActiveCell.Offset(1, 0).Select

Burada da BI sütununda bulunan veri BK sütununda yok ise Listbox5'e akleyecek
For i = 2 To Worksheets("üp").Cells(Rows.Count, 1).End(3).Row
If Worksheets("üp").Cells(i, 1).Value <> Worksheets("üp").Cells(i, 3).Value Then
ListBox5.AddItem Worksheets("üp").Cells(i, 1).Value
End If
Next

ahmed_ummu · 5 Nisan 2024

Bir örnek dosya hazırladım ve ekledim. Hala sorunu çözemedim.

Örnek dosyada "ÜP" sayfasında "BJ" ve "BL" sütunlarında listelerim var. (Bazı işlemlerden sonra oluşan listeler.) Yapmak istediğim ise eğer "BJ" sütunundaki veri "BL" sütununda yok ise Listbox5'e ekleyecek. Ben de BL sütununda olanları da ekliyor.

Mesela ÜP sayfasında BJ sütununda 5 adetlik bir liste var. (örnek olarak 5 tane yazdım. 150 civarında) Bunlardan 2 tanesi BL sütununda. BL sütununda olmayan 3 veriyi listbox5'e ekleyecek.

(Combobox12'den TEMEL EĞİTİM GENEL MÜDÜRLÜĞÜ" seçilince bu sütunlarda işlem yapılıyor. Combobox12'den ORTAÖĞRETİM GENEL MÜDÜRLÜĞÜ seçilince BM ve BO sütunlarında işlem yapılıyor. Combobox12 den seçilen verilere göre işlem yapılacak sütunlar değişkenlik gösteriyor.

ekte gönderdiğim OKUL-MUHASEBE_BÜRO_KLASÖRLERİ klasörü masaüstünde olacak.

veyselemre · 5 Nisan 2024

Kod:

    '******************
    ListBox5.Clear
    Select Case ComboBox12.Value
        Case Is = "TEMEL EĞİTİM GENEL MÜDÜRLÜĞÜ"
            Set fso = VBA.CreateObject("scripting.filesystemobject")
            yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\OKUL-MUHASEBE_BÜRO_KLASÖRLERİ\ÜCRETLİ_ÖĞRETMEN_PUANTAJLARI\TEMEL EĞİTİM GENEL MÜDÜRLÜĞÜ"
            For Each kls In fso.getfolder(yol).Files
                ListBox4.AddItem fso.getbasename(kls.Name)
            Next kls
            sut1 = "BL": sut2 = "BJ"  '**************
        Case Is = "ORTAÖĞRETİM GENEL MÜDÜRLÜĞÜ"
            Set fso = VBA.CreateObject("scripting.filesystemobject")
            yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\OKUL-MUHASEBE_BÜRO_KLASÖRLERİ\ÜCRETLİ_ÖĞRETMEN_PUANTAJLARI\ORTAÖĞRETİM GENEL MÜDÜRLÜĞÜ"
            For Each kls In fso.getfolder(yol).Files
                ListBox4.AddItem fso.getbasename(kls.Name)
            Next kls
            sut1 = "BO": sut2 = "BM"  '**************
    End Select
    With Sheets("ÜP")
        v1 = .Range(.Cells(2, sut1), .Cells(Rows.Count, sut1).End(3)).Value
        v2 = .Range(.Cells(2, sut2), .Cells(Rows.Count, sut2).End(3)).Value
    End With
    With CreateObject("Scripting.Dictionary")
        For Each elem In IIf(IsArray(v1), v1, Array(v1))
            If elem <> "" Then .Item(elem) = Null
        Next elem
        For Each elem In IIf(IsArray(v2), v2, Array(v2))
            If elem <> "" Then If Not .exists(elem) Then ListBox5.AddItem (elem)
        Next elem
    End With
    '******************

ahmed_ummu · 6 Nisan 2024

veyselemre' Alıntı:

Kod:

    '******************
    ListBox5.Clear
    Select Case ComboBox12.Value
        Case Is = "TEMEL EĞİTİM GENEL MÜDÜRLÜĞÜ"
            Set fso = VBA.CreateObject("scripting.filesystemobject")
            yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\OKUL-MUHASEBE_BÜRO_KLASÖRLERİ\ÜCRETLİ_ÖĞRETMEN_PUANTAJLARI\TEMEL EĞİTİM GENEL MÜDÜRLÜĞÜ"
            For Each kls In fso.getfolder(yol).Files
                ListBox4.AddItem fso.getbasename(kls.Name)
            Next kls
            sut1 = "BL": sut2 = "BJ"  '**************
        Case Is = "ORTAÖĞRETİM GENEL MÜDÜRLÜĞÜ"
            Set fso = VBA.CreateObject("scripting.filesystemobject")
            yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\OKUL-MUHASEBE_BÜRO_KLASÖRLERİ\ÜCRETLİ_ÖĞRETMEN_PUANTAJLARI\ORTAÖĞRETİM GENEL MÜDÜRLÜĞÜ"
            For Each kls In fso.getfolder(yol).Files
                ListBox4.AddItem fso.getbasename(kls.Name)
            Next kls
            sut1 = "BO": sut2 = "BM"  '**************
    End Select
    With Sheets("ÜP")
        v1 = .Range(.Cells(2, sut1), .Cells(Rows.Count, sut1).End(3)).Value
        v2 = .Range(.Cells(2, sut2), .Cells(Rows.Count, sut2).End(3)).Value
    End With
    With CreateObject("Scripting.Dictionary")
        For Each elem In IIf(IsArray(v1), v1, Array(v1))
            If elem <> "" Then .Item(elem) = Null
        Next elem
        For Each elem In IIf(IsArray(v2), v2, Array(v2))
            If elem <> "" Then If Not .exists(elem) Then ListBox5.AddItem (elem)
        Next elem
    End With
    '******************

veyselemre bey çok teşekkür ederim. Elinize sağlık.

ahmed_ummu · 7 Nisan 2024

veyselemre' Alıntı:

Kod:

    '******************
    ListBox5.Clear
    Select Case ComboBox12.Value
        Case Is = "TEMEL EĞİTİM GENEL MÜDÜRLÜĞÜ"
            Set fso = VBA.CreateObject("scripting.filesystemobject")
            yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\OKUL-MUHASEBE_BÜRO_KLASÖRLERİ\ÜCRETLİ_ÖĞRETMEN_PUANTAJLARI\TEMEL EĞİTİM GENEL MÜDÜRLÜĞÜ"
            For Each kls In fso.getfolder(yol).Files
                ListBox4.AddItem fso.getbasename(kls.Name)
            Next kls
            sut1 = "BL": sut2 = "BJ"  '**************
        Case Is = "ORTAÖĞRETİM GENEL MÜDÜRLÜĞÜ"
            Set fso = VBA.CreateObject("scripting.filesystemobject")
            yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\OKUL-MUHASEBE_BÜRO_KLASÖRLERİ\ÜCRETLİ_ÖĞRETMEN_PUANTAJLARI\ORTAÖĞRETİM GENEL MÜDÜRLÜĞÜ"
            For Each kls In fso.getfolder(yol).Files
                ListBox4.AddItem fso.getbasename(kls.Name)
            Next kls
            sut1 = "BO": sut2 = "BM"  '**************
    End Select
    With Sheets("ÜP")
        v1 = .Range(.Cells(2, sut1), .Cells(Rows.Count, sut1).End(3)).Value
        v2 = .Range(.Cells(2, sut2), .Cells(Rows.Count, sut2).End(3)).Value
    End With
    With CreateObject("Scripting.Dictionary")
        For Each elem In IIf(IsArray(v1), v1, Array(v1))
            If elem <> "" Then .Item(elem) = Null
        Next elem
        For Each elem In IIf(IsArray(v2), v2, Array(v2))
            If elem <> "" Then If Not .exists(elem) Then ListBox5.AddItem (elem)
        Next elem
    End With
    '******************

Sayın veyselemre bey gönderdiğiniz kodda söyle bir sorun oluyor. Sadece BO ve BM sütunları için seçenek yapılmış.
Hangi sütunlarda işlem yapacağı Combobox12 den seçilen değere göre oluyor.

Mesela,
Combobox12 den,
"TEMEL EĞİTİM GENEL MÜDÜRLÜĞÜ" seçilince BJ-BL sütunlarında,
"ORTAÖĞRETİM GENEL MÜDÜRLÜĞÜ" seçilince BM-BO sütunlarında,
"MESLEKİ VE TEKNİK EĞİTİM GENEL MÜDÜRLÜĞÜ" seçilince BP-BR sütunlarında,
"DİN ÖĞRETİMİ GENEL MÜDÜRLÜĞÜ" seçilince BS-BU sütunlarında,
"ÖZEL EĞİTİM VE REHBERLİK HİZMETLERİ GENEL MÜDÜRLÜĞÜ" seçilince BV-BX sütunlarında,
"HAYAT BOYU ÖĞRENME GENEL MÜDÜRLÜĞÜ" seçilince BY-CA sütnlarında,
"ÖZEL EĞİTİM KURUMLARI GENEL MÜDÜRLÜĞÜ" seçilince CB-CD sütunlarında, işlem yapacak. Select Cace ile bütün sütunları dahil ettim ama kod hem çok uzun oldu hem de sadece TEMEL EĞİTİM GENEL MÜDÜRLÜĞÜ'ünde sonuç doğdu çıkıyor. Diğer seçeneklerde listeye eklenmemesi gereken okulları da eliyor. İlgilenirseniz çok memnun olurum.

ahmed_ummu · 7 Nisan 2024

veyselemre' Alıntı:

Kod:

    '******************
    ListBox5.Clear
    Select Case ComboBox12.Value
        Case Is = "TEMEL EĞİTİM GENEL MÜDÜRLÜĞÜ"
            Set fso = VBA.CreateObject("scripting.filesystemobject")
            yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\OKUL-MUHASEBE_BÜRO_KLASÖRLERİ\ÜCRETLİ_ÖĞRETMEN_PUANTAJLARI\TEMEL EĞİTİM GENEL MÜDÜRLÜĞÜ"
            For Each kls In fso.getfolder(yol).Files
                ListBox4.AddItem fso.getbasename(kls.Name)
            Next kls
            sut1 = "BL": sut2 = "BJ"  '**************
        Case Is = "ORTAÖĞRETİM GENEL MÜDÜRLÜĞÜ"
            Set fso = VBA.CreateObject("scripting.filesystemobject")
            yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\OKUL-MUHASEBE_BÜRO_KLASÖRLERİ\ÜCRETLİ_ÖĞRETMEN_PUANTAJLARI\ORTAÖĞRETİM GENEL MÜDÜRLÜĞÜ"
            For Each kls In fso.getfolder(yol).Files
                ListBox4.AddItem fso.getbasename(kls.Name)
            Next kls
            sut1 = "BO": sut2 = "BM"  '**************
    End Select
    With Sheets("ÜP")
        v1 = .Range(.Cells(2, sut1), .Cells(Rows.Count, sut1).End(3)).Value
        v2 = .Range(.Cells(2, sut2), .Cells(Rows.Count, sut2).End(3)).Value
    End With
    With CreateObject("Scripting.Dictionary")
        For Each elem In IIf(IsArray(v1), v1, Array(v1))
            If elem <> "" Then .Item(elem) = Null
        Next elem
        For Each elem In IIf(IsArray(v2), v2, Array(v2))
            If elem <> "" Then If Not .exists(elem) Then ListBox5.AddItem (elem)
        Next elem
    End With
    '******************

Select Case ile yaptığım örnek ektedir. Kodlar Combobox12 nin içinde

halit3 · 7 Nisan 2024

UserForm_Initialize
kodunu bununla değiştir.

Kod:

Private Sub UserForm_Initialize()
Set s1 = Sheets("PARAMETRELER")
For s = 1 To s1.Cells(Rows.Count, "CN").End(xlUp).Row
ComboBox12.AddItem s1.Cells(s, "CN").Value
Next s
End Sub

ComboBox12_Click kodu

Kod:

Private Sub ComboBox12_Click()


ListBox5.Clear
Set s1 = Sheets("ÜP")
sut1 = 59

bas = ComboBox12.ListIndex + 1
sut2 = (bas * 3) + sut1
sut3 = sut2 + 2

For s = 2 To s1.Cells(Rows.Count, sut2).End(xlUp).Row
aranan = s1.Cells(s, sut2).Value
Say = 0

For k = 2 To s1.Cells(Rows.Count, sut3).End(xlUp).Row
bulunan = s1.Cells(k, sut3).Value
If aranan = bulunan Then
Say = Say + 1
GoTo atla
End If
Next k

If Say = 0 Then
ListBox5.AddItem s1.Cells(s, sut2).Value
End If
atla:
Next s


End Sub

ahmed_ummu · 8 Nisan 2024

halit3' Alıntı:

UserForm_Initialize
kodunu bununla değiştir.

Kod:

Private Sub UserForm_Initialize()
Set s1 = Sheets("PARAMETRELER")
For s = 1 To s1.Cells(Rows.Count, "CN").End(xlUp).Row
ComboBox12.AddItem s1.Cells(s, "CN").Value
Next s
End Sub

ComboBox12_Click kodu

Kod:

Private Sub ComboBox12_Click()


ListBox5.Clear
Set s1 = Sheets("ÜP")
sut1 = 59

bas = ComboBox12.ListIndex + 1
sut2 = (bas * 3) + sut1
sut3 = sut2 + 2

For s = 2 To s1.Cells(Rows.Count, sut2).End(xlUp).Row
aranan = s1.Cells(s, sut2).Value
Say = 0

For k = 2 To s1.Cells(Rows.Count, sut3).End(xlUp).Row
bulunan = s1.Cells(k, sut3).Value
If aranan = bulunan Then
Say = Say + 1
GoTo atla
End If
Next k

If Say = 0 Then
ListBox5.AddItem s1.Cells(s, sut2).Value
End If
atla:
Next s


End Sub

Çok sağol Halit. Eline sağlık. Kodlar bayağı kısaldı.

halit3 · 8 Nisan 2024

Kodlar biraz daha kısaldı

Kod:

Private Sub ComboBox12_Click()

ListBox5.Clear
Set s1 = Sheets("ÜP")

sut2 = ((ComboBox12.ListIndex + 1) * 3) + 59
sut3 = sut2 + 2

For s = 2 To s1.Cells(Rows.Count, sut2).End(xlUp).Row
For k = 2 To s1.Cells(Rows.Count, sut3).End(xlUp).Row
If s1.Cells(s, sut2).Value = s1.Cells(k, sut3).Value Then
GoTo atla
End If
Next k

ListBox5.AddItem s1.Cells(s, sut2).Value

atla:
Next s
End Sub

ahmed_ummu · 15 Nisan 2024

halit3' Alıntı:

Kodlar biraz daha kısaldı

Kod:

Private Sub ComboBox12_Click()

ListBox5.Clear
Set s1 = Sheets("ÜP")

sut2 = ((ComboBox12.ListIndex + 1) * 3) + 59
sut3 = sut2 + 2

For s = 2 To s1.Cells(Rows.Count, sut2).End(xlUp).Row
For k = 2 To s1.Cells(Rows.Count, sut3).End(xlUp).Row
If s1.Cells(s, sut2).Value = s1.Cells(k, sut3).Value Then
GoTo atla
End If
Next k

ListBox5.AddItem s1.Cells(s, sut2).Value

atla:
Next s
End Sub

Geçmiş bayramın mübarek olsun Halit.

Daha da kısaldı kodlar.

Listbox'a Veri Listeleme

ahmed_ummu

Zeki Gürsoy

Uzman

ahmed_ummu

ahmed_ummu

Ekli dosyalar

veyselemre

Özel Üye

ahmed_ummu

ahmed_ummu

ahmed_ummu

Ekli dosyalar

halit3

Uzman

ahmed_ummu

halit3

Uzman

ahmed_ummu