Çözüldü Combobox ile mükerrersiz ve birbirine bağlı liste oluşturmak

[sirkülasyon]

Arşiv sayfasında
Müteahhitin Adı Soyadı Ara sayfasında ki birinci comboboxa mükerrersiz olarak getirmek
Seçilen Müteahhite bağlı Alt Yüklenicilerin Adı Soyadlarını Ara sayfasında ki İkinci combobaxa getirmek
En son seçilen alt yükleniciye verilmiş tüm işleri listboxta getirmek

Birde listboxa gelen işin adına tıklama yapıldığı zaman ARŞİV sayfasındaki tüm bilgileri ARA sayfasına 8. satırdan itibaren aktarmak

Rica etsem makro ile işlemleri yapabilmem için yardımcı olabilir misiniz?
Saygı ve hürmetlerimle

İLGİLİ DOSYA

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodun tamamını ara sayfasının kod bölümüne kopyalayıp deneyiniz.

Dim Ar As Worksheet, a As Long
Private Sub ComboBox1_Change()
Set Ar = Sheets("ARŞİV")
Application.EnableEvents = False
ComboBox2.Clear
For a = 5 To Ar.Cells(Rows.Count, "C").End(3).Row
    If Ar.Cells(a, "C") = ComboBox1.Value And WorksheetFunction.CountIf(Ar.Range("F5:F" & a), Ar.Cells(a, "F")) = 1 Then
        ComboBox2.AddItem Ar.Cells(a, "F")
    End If
Next
Application.EnableEvents = True
If ComboBox2.ListCount > 0 Then ComboBox2.Value = ComboBox2.List(0)
End Sub

Private Sub ComboBox2_Change()
Set Ar = Sheets("ARŞİV")
Application.EnableEvents = False
ListBox1.Clear
For a = 5 To Ar.Cells(Rows.Count, "C").End(3).Row
    If Ar.Cells(a, "C") = ComboBox1.Value And Ar.Cells(a, "F") = ComboBox2.Value Then
        ListBox1.AddItem Ar.Cells(a, "E")
    End If
Next
Application.EnableEvents = True
End Sub

Private Sub ListBox1_Click()
Set Ar = Sheets("ARŞİV")
Application.EnableEvents = False
Range("8:8000").ClearContents
For a = 5 To Ar.Cells(Rows.Count, "C").End(3).Row
    If Ar.Cells(a, "C") = ComboBox1.Value And Ar.Cells(a, "F") = ComboBox2.Value And Ar.Cells(a, "E") = ListBox1.Value Then
        son = Cells(Rows.Count, "C").End(3).Row + 1
        Cells(son, 1).Resize(, 15).Value = Ar.Cells(a, "A").Resize(, 15).Value
    End If
Next
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Activate()
Set Ar = Sheets("ARŞİV")
Application.EnableEvents = False
ComboBox1.Clear
For a = 5 To Ar.Cells(Rows.Count, "C").End(3).Row
    If WorksheetFunction.CountIf(Ar.Range("C5:C" & a), Ar.Cells(a, "C")) = 1 Then
        ComboBox1.AddItem Ar.Cells(a, "C")
    End If
Next
Range("8:8000").ClearContents
Application.EnableEvents = True
If ComboBox1.ListCount > 0 Then ComboBox1.Value = ComboBox1.List(0)
End Sub

 

[sirkülasyon]

Allah ne muradın varsa versin.

 

[ÖmerBey]

Amin,
Allah razı olsun, iyi çalışmalar...