Seçenek sunarak makroyu çalıştırmak

[1Al2Ver]

Merhaba,

Başlık doğru mu oldu bilmiyorum, ancak aşağı açılır kutu ile, seçilen sütun adına göre, makronun çalışmasını arzuluyorum.

"Yemek_Listesi" sayfası A2 hücresine açılır kutu ile harf seçildiğinde, mevcut makronun işlevi, bu sütuna göre çalışmalı.

Örneğin A2; D ise seçimi "D" sütununda ilk boş hücreye,A2; E ise, seçimi "E" sütununda ilk boş hücreye..... yazsın.

Dosyada TextBox1 ve ListBox1 mevcuttur, ayrıca "liste" isimli ad tanımlama mevcuttur.

Teşekkür ederim.

 

[Korhan Ayhan]

Sayfanızdaki kodların yerine aşağıdaki kodları deneyiniz.

Private Sub ListBox1_Click()
    On Error Resume Next
    Dim S1 As Worksheet, S2 As Worksheet, X As Integer, Sutun As String
    Set S1 = Sheets("YEMEKLER")
    Set S2 = Sheets("YEMEK_LİSTESİ")
    Sutun = S2.Range("A2").Value
    X = S1.Range("Liste").Cells.Find(What:=ListBox1, LookIn:=xlValues).Row
    TextBox1 = S1.Cells(X, 2)
    S2.Cells(S2.Rows.Count, Sutun).End(3).Rows.Offset(1, 0) = TextBox1
    ListBox1.Visible = False
    Set S2 = Nothing
    Set S1 = Nothing
End Sub

Private Sub TextBox1_Change()
    Dim S1 As Worksheet, Veri As Range, Say As Integer
    Set S1 = Sheets("YEMEKLER")
    On Error Resume Next
    ListBox1.Clear
    For Each Veri In S1.Range("Liste")
        If Left(LCase(Veri), Len(TextBox1)) = LCase(TextBox1) Then ListBox1.AddItem (Veri)
    Next
    Set S1 = Nothing
    ListBox1.Visible = True
    ListBox1.Height = 280
    ListBox1.Width = 200
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 8 Then
        ListBox1.Clear
    End If
End Sub

 

[1Al2Ver]

Sayın Korhan AYHAN, merhaba,

Çok çok teşekkür ederim, elinize sağlık.

Saygılarımla.