• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

combobox larla ilgili sorunuma hala çözüm bulamadım.

ynmcan

ynmcan

Katılım
30 Ağustos 2008
Mesajlar
677
Excel Vers. ve Dili
2010 türkçe
Merhaba arkadaşlar;
Ekte olan örnek dosyama forumdan daha önce gelen yardımlar benim kulanacağım ana proje için çok karmaşık geldi.mümkünse daha basit makro veya kodlar olursa sevinirim.şimdiden çok teşekkür ederim.
 
Bu kodları bir dener misiniz ?
Kod: 
Private Sub ComboBox1_Change()
    On Error Resume Next
    If ComboBox2 = ComboBox1 Or ComboBox3 = ComboBox1 Then
    MsgBox "Bu değeri seçemezsiniz"
    ComboBox1 = ""
    End If
    a = WorksheetFunction.Match(Val(ComboBox1), Sayfa2.Rows(2), 0)
    Sayfa2.Cells(2, a).Interior.Color = vbGreen
End Sub
Private Sub ComboBox2_Change()
    On Error Resume Next
    If ComboBox2 = ComboBox3 Or ComboBox2 = ComboBox1 Then
    MsgBox "Bu değeri seçemezsiniz"
    ComboBox2 = ""
    End If
    a = WorksheetFunction.Match(Val(ComboBox2), Sayfa2.Rows(2), 0)
    Sayfa2.Cells(2, a).Interior.Color = vbGreen
End Sub
Private Sub ComboBox3_Change()
    On Error Resume Next
    If ComboBox2 = ComboBox3 Or ComboBox3 = ComboBox1 Then
    MsgBox "Bu değeri seçemezsiniz"
    ComboBox3 = ""
    Exit Sub
    End If
    a = WorksheetFunction.Match(Val(ComboBox3), Sayfa2.Rows(2), 0)
    Sayfa2.Cells(2, a).Interior.Color = vbGreen
End Sub
 
Merhaba' syn.Hamitcan
yolladığınız kodu denedim. kod çok güzel tam istediğim gibi sade.Ancak ufak bir sorunu var;Combobox larda yeni bir seçim yaptığımda, önceki yeşil olan hücreler temizlensin,yalnızca yeni seçtiğim hücerelerin rengi yeşil olsun.Bunuda ayarlarsanız süper olacak.
 
Kod: 
Private Sub ComboBox1_Change()
    On Error Resume Next
    renkleri_sil
    If ComboBox2 = ComboBox1 Or ComboBox3 = ComboBox1 Then
    MsgBox "Bu değeri seçemezsiniz"
    ComboBox1 = ""
    End If
    a = WorksheetFunction.Match(Val(ComboBox1), Sayfa2.Rows(2), 0)
    Sayfa2.Cells(2, a).Interior.Color = vbGreen
End Sub
Private Sub ComboBox2_Change()
   On Error Resume Next
    renkleri_sil
    If ComboBox2 = ComboBox3 Or ComboBox2 = ComboBox1 Then
    MsgBox "Bu değeri seçemezsiniz"
    ComboBox2 = ""
    End If
    a = WorksheetFunction.Match(Val(ComboBox2), Sayfa2.Rows(2), 0)
    Sayfa2.Cells(2, a).Interior.Color = vbGreen
End Sub
Private Sub ComboBox3_Change()
    On Error Resume Next
    renkleri_sil
    If ComboBox2 = ComboBox3 Or ComboBox3 = ComboBox1 Then
    MsgBox "Bu değeri seçemezsiniz"
    ComboBox3 = ""
    Exit Sub
    End If
    a = WorksheetFunction.Match(Val(ComboBox3), Sayfa2.Rows(2), 0)
    Sayfa2.Cells(2, a).Interior.Color = vbGreen
End Sub
Sub renkleri_sil()
    For Each hcr In Sayfa2.[c2:k2]
    If hcr.Interior.Color = vbGreen Then
    s = s + 1
    If s = 3 Then Sayfa2.Rows(2).Interior.Color = xlNone
    End If
    Next
End Sub
 
Merhaba' Syn.Hamitcan
Bu kod ta çok güzel olmuş ellerinize sağlık.
Ben bir şey daha rica edeceğim.Örnek dosyaya bir combobox daha ekledim. Bununla öbür üçünün listesini değiştirmek istiyorum.Örnek dosya aşağıda.
 
kusura bakmayın acil bir işim çıktığından dosyayı eklemeyi unutmuşum.
 
Diğer bütün kodları silip, aşağıdaki kodları ekleyin.
Kod: 
Public sat As Long
Private Sub ComboBox1_Change()
    On Error Resume Next
    renkleri_sil
    If ComboBox2 = ComboBox1 Or ComboBox3 = ComboBox1 Then
    MsgBox "Bu değeri seçemezsiniz"
    ComboBox1 = ""
    End If
    a = WorksheetFunction.Match(Val(ComboBox1), Sayfa2.Rows(sat), 0)
    Sayfa2.Cells(sat, a).Interior.Color = vbGreen
End Sub
Private Sub ComboBox2_Change()
    On Error Resume Next
    renkleri_sil
    If ComboBox2 = ComboBox3 Or ComboBox2 = ComboBox1 Then
    MsgBox "Bu değeri seçemezsiniz"
    ComboBox2 = ""
    End If
    a = WorksheetFunction.Match(Val(ComboBox2), Sayfa2.Rows(sat), 0)
    Sayfa2.Cells(sat, a).Interior.Color = vbGreen
End Sub
Private Sub ComboBox3_Change()
    On Error Resume Next
    renkleri_sil
    If ComboBox2 = ComboBox3 Or ComboBox3 = ComboBox1 Then
    MsgBox "Bu değeri seçemezsiniz"
    ComboBox3 = ""
    Exit Sub
    End If
    a = WorksheetFunction.Match(Val(ComboBox3), Sayfa2.Rows(sat), 0)
    Sayfa2.Cells(sat, a).Interior.Color = vbGreen
End Sub
Private Sub ComboBox4_Change()
    ComboBox1.Clear
    ComboBox2.Clear
    ComboBox3.Clear
    For Each hcr In Sayfa2.Range("c" & sat & ":k" & sat)
    ComboBox1.AddItem hcr.Value
    ComboBox2.AddItem hcr.Value
    ComboBox3.AddItem hcr.Value
    Next
End Sub
Sub renkleri_sil()
    sat = Right(ComboBox4, Len(ComboBox4) - 6) + 1
    For Each hcr In Sayfa2.Range("c" & sat & ":k" & sat)
    If hcr.Interior.Color = vbGreen Then
    s = s + 1
    If s = 3 Then Sayfa2.Rows(sat).Interior.Color = xlNone
    End If
    Next
End Sub
 
Sayın Hamitcan, yolladığınz codu denedim ancak

Private Sub ComboBox4_Change()
ComboBox1.Clear
ComboBox2.Clear
ComboBox3.Clear
For Each hcr In Sayfa2.Range("c" & sat & ":k" & sat)
ComboBox1.AddItem hcr.Value
ComboBox2.AddItem hcr.Value
ComboBox3.AddItem hcr.Value
Next
End Sub
satırında hata veriyor.
dosya ekte
 
Kod: 
Private Sub ComboBox4_Change()
    sat = Right(ComboBox4, Len(ComboBox4) - 6) + 1
    ComboBox1.Clear
    ComboBox2.Clear
    ComboBox3.Clear
    For Each hcr In Sayfa2.Range("c" & sat & ":k" & sat)
    ComboBox1.AddItem hcr.Value
    ComboBox2.AddItem hcr.Value
    ComboBox3.AddItem hcr.Value
    Next
End Sub
şeklinde değiştirir misiniz ?
 
Syn. Hamitcan, combobox tan satır seçince ''bu değeri seçemezsiniz'' mesajı geliyor.
dosya ekte
 
Siz dosyaya eski kodları da eklemişsiniz. Sadece son gönderdiklerimi ekleyin.
 
Ben sizin 8. mesajda yoladığınız kod taki, ''combobox4'' e ait satırı yolladığınız yeni kodla değiştirdim.Bu yaptığımda bir hata varmı?
 
Son gönderdiğiniz örnekte eski kodlar da mevcuttu.
 
Sayın Hamitcan,
Kusura bakmayın ben eski kod göremedim,ama yanılabilirim yolladığım eki inceleyebirirmisiniz?
 
1-Module 1 içindeki kodları silmeniz gerekiyor.
2-Diğer isteğinizi 18:00 e kadar yetiştirmeye çalışacağım.
 
Üzgünüm, Bayram sonrası bakabileceğim.
 
Sayın Hamitcan,
Katkılarınızdan dolayı çok teşekkür ediyorum,ellerinize sağlık.
Sayenizde büyük bir yol katettim.
Geri kalan kısmını kendim halletmeye çalışırım. Olmazsa bayramdan sonra size ulaşırım.
Şimdiden bayramınızı kutlar,nice sağlıklı ve mutlu bayramlar dilerim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst