Userformda üçlü combobox ile kod getirip sayfaya aktarma

[Yesilyurtlu]

Değerli Üstadlarım;
Sitede bu konu ile ilgili bir kaç kere istirhamım oldu. Uzmanlarım tarafından da çözüldü.
Ancak İdare tarafından böyle bir format düzenlenmemi istediler. Onun için tekrar yardımlarınıza ihtiyaç duyuyorum. İnşallah yardımlarınızı esirgemezsiniz.
Açıklama ekteki dosyamda mevcut.

Şimdiden Sonsuz teşekkürlerimi sunuyorum.

 

[kan-nas]

SN. Yeşilyurtlu ,
Birşeyler yapmaya çalıştım. Bir kodları uyarlayın kendinize.

Private Sub ComboBox3_Change()
Range("b:b").Select
Selection.Find(ComboBox3).Select
TextBox1.Value = ActiveCell.Offset(0, 2)
End Sub
Private Sub CommandButton1_Click()
Sheets("Resmi Yazı").Select
Range("c7").Value = TextBox1.Value
End Sub
Private Sub UserForm_Initialize()
For i = 1 To Range("A65536").End(3).Row
If Cells(i, 1).Value = 1 Then
ComboBox1.AddItem Cells(i, 2)
End If
If Cells(i, 1).Value = 2 Then
ComboBox2.AddItem Cells(i, 2)
End If
If Cells(i, 1).Value = 3 Then
ComboBox3.AddItem Cells(i, 2)
End If
Next
End Sub

Not: A sutununa ... combobox yazmışsınız ya ben oradan . combobox kısımlarını sildim sadece rakam kısmı kaldı. Kodları o rakamlara göre yaptım.Onları silmeyiniz.

 

[kan-nas]

Üstad bu da Font renklerine göre çalışıyor. A sütunundaki bildgileri silebilirsin.

Private Sub ComboBox3_Change()
Range("b:b").Select
Selection.Find(ComboBox3).Select
TextBox1.Value = ActiveCell.Offset(0, 2)
End Sub
Private Sub CommandButton1_Click()
Sheets("Resmi Yazı").Select
Range("c7").Value = TextBox1.Value
End Sub
Private Sub UserForm_Initialize()
For i = 4 To Range("b65536").End(3).Row
If Cells(i, 2).Font.Color = vbBlue Then
ComboBox1.AddItem Cells(i, 2)
End If
If Cells(i, 2).Font.Color = vbRed Then
ComboBox2.AddItem Cells(i, 2)
End If
If Cells(i, 2).Font.Color = vbBlack Then
ComboBox3.AddItem Cells(i, 2)
End If
Next
End Sub

 

[Yesilyurtlu]

Sayın kan-nas
Emeğine yardımına teşekkür ederim.
Ancak ben kodu ilk mesaj dosyama ekledim beceremedim.
Sonucu görmem açısından yardımcı olabilir misiniz?

 

[Vedat Özer]

Selamlar,

Aşagıdaki kodlar işinize yararmı ?
Kodlar alıntıdır.

Dim a As String
Private Sub ComboBox1_Change()
Dim ts, bordo, asi, mavi
Set bordo = Sheets("Sayfa1")
Set mavi = Sheets("kral")
ComboBox2.Clear: ComboBox3.Clear
asi = 0
For ts = 3 To bordo.Cells(Rows.Count, "B").End(xlUp).Row
If mavi.Cells(ts, "A") = ComboBox1.ListIndex + 1 And _
bordo.Cells(ts, "B").Font.Color = vbRed Then
ComboBox2.AddItem bordo.Cells(ts, "B")
asi = asi + 1
End If
mavi.Cells(ts, "B") = asi
Next
End Sub
Private Sub ComboBox2_Change()
Dim ts, bordo, asi, mavi
Set bordo = Sheets("Sayfa1")
Set mavi = Sheets("kral")
ComboBox3.Clear
asi = 0
For ts = 3 To bordo.Cells(Rows.Count, "B").End(xlUp).Row
If mavi.Cells(ts, "A") = ComboBox1.ListIndex + 1 And _
mavi.Cells(ts, "B") = ComboBox2.ListIndex + 1 And _
bordo.Cells(ts, "B").Font.Color = vbBlack Then
ComboBox3.AddItem bordo.Cells(ts, "B")
asi = asi + 1
End If
mavi.Cells(ts, "C") = asi
Next
End Sub
Private Sub ComboBox3_Change()
Dim ts, bordo, asi, mavi
Set bordo = Sheets("Sayfa1")
Set mavi = Sheets("kral")
For ts = 3 To bordo.Cells(Rows.Count, "B").End(xlUp).Row
If mavi.Cells(ts, "A") = ComboBox1.ListIndex + 1 And _
mavi.Cells(ts, "B") = ComboBox2.ListIndex + 1 And _
mavi.Cells(ts, "C") = ComboBox3.ListIndex + 1 Then
TextBox1 = bordo.Cells(ts, "D") & "." & bordo.Cells(ts, "C") & " /"
End If
Next
End Sub
Private Sub CommandButton1_Click()
Sheets("Resmi Yazı").Range("C7") = TextBox1
End Sub
Private Sub UserForm_Initialize()
Dim ts, bordo, asi, mavi
a = ActiveSheet.Name
Set bordo = Sheets("Sayfa1")
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "kral"
Set mavi = Sheets("kral")
bordo.Select
asi = 0
For ts = 3 To bordo.Cells(Rows.Count, "B").End(xlUp).Row
If bordo.Cells(ts, "B").Font.Color = vbBlue Then
ComboBox1.AddItem bordo.Cells(ts, "B")
asi = asi + 1
End If
mavi.Cells(ts, "A") = asi
Next
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Sheets(a).Select
Application.DisplayAlerts = False
Sheets("kral").Delete
Application.DisplayAlerts = True
End Sub

 

[kan-nas]

Üstad dosyayı ekledim. bir bakın.

 

[Yesilyurtlu]

Sayın Kan-nas Eklemiş olduğunuz dosyaya baktım elinize sağlık ancak bölümlendirme olmamış.
Sayın Vedat Uzmanımın kodunu kullandım şu an için bir sıkıntı görülmüyor.
Her iki ağabeylerime sonsuz teşekkürlerimi sunuyorum.
Yardımınızı esirgemediğiniz için Allah Razı Olsun

 

[Yesilyurtlu]

Vedat Abi;
Kod birebir uydu ancak benden kaynaklanan bir anlatım eksikliğinden dolayı bir hata var.
Kırmızı renkli olan ve altında konu olmayan ikili kırmızı altalta olanların kodunu textboxa vermiyor.
Örneğin:
1. Combobox ile ana başlığı seçtim, 2. Combobox ile seçtim üçüncü comboboxa alt açılırı olmadığı için textboxa kodu vermiyor.
Eğer 3. comboboxa menü aktarılmayacaksa ikinci comboboxtanda textboxa aktarabilir miyiz?
Öyle yardımcı olabilirseniz memnun olurum

 

[Yesilyurtlu]

Vedat Abi ;
Ekli Dosyaya bakabilir misiniz?
1. Comboboxtan sonra 2. Comboboxa açılacak menü yok ise textboxa kodu vermesini
2. Comboboxtan sonra 3. Comboboxa açılacak menü yok ise textboxa kodu vermesini
sağlayabilir misiniz?

 

[Yesilyurtlu]

Üstad Hallettim

Teşekkür Ederim

Sorum cevaplanmıştır.