Listbox'a Veri Listeleme

[ahmed_ummu]

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]

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]

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]

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]

    '******************
    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]

    '******************
    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]

    '******************
    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]

    '******************
    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]

UserForm_Initialize
kodunu bununla değiştir.

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

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]

UserForm_Initialize
kodunu bununla değiştir.

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

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]

Kodlar biraz daha kısaldı

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]

Kodlar biraz daha kısaldı

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.