• DİKKAT

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

Select / Case yöntemi

  • Konbuyu başlatan Konbuyu başlatan s.savas
  • Başlangıç tarihi Başlangıç tarihi
S

s.savas

Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
Merhaba arkadaşlar.
ComboBox ların aldığı değere göre, istenilen sonucun TextBox ta gösterilmesi için basit bir örnek hazırladım. Bu örnekte Select case yöntemini kullanarak nasıl yapacağımı öğrenmek istiyorum.

Kişinin Adı Soyadı ve Baba Adını seçerek, Doğum Yerini TextBox ta görmek istiyorum.
Yardımcı olacak arkadaşlara teşkkür ederim.
 

Ekli dosyalar

Selamlar,

Kullanmak istediğiniz yöntem bu işlem için uygun yöntem değildir. Bunun yerine For-Next döngüsü kullanmalısınız.

Formunuzun kod bölümüne aşağıdaki kodu ekleyip deneyiniz.

Kod: 
Private Sub ComboBox1_Change()
    If ComboBox1 <> "" And ComboBox2 <> "" Then
        With Sheets("Sayfa3")
            For X = 2 To .Range("A65536").End(3).Row
                If .Cells(X, 1) = ComboBox1 And .Cells(X, 2) = ComboBox2 Then
                    TextBox1 = .Cells(X, 3)
                    Exit For
                End If
            Next
        End With
    End If
End Sub
 
Private Sub ComboBox2_Change()
    If ComboBox1 <> "" And ComboBox2 <> "" Then
        With Sheets("Sayfa3")
            For X = 2 To .Range("A65536").End(3).Row
                If .Cells(X, 1) = ComboBox1 And .Cells(X, 2) = ComboBox2 Then
                    TextBox1 = .Cells(X, 3)
                    Exit For
                End If
            Next
        End With
    End If
End Sub
 
Korhan Ayhan' Alıntı:
Selamlar,

Kullanmak istediğiniz yöntem bu işlem için uygun yöntem değildir. Bunun yerine For-Next döngüsü kullanmalısınız.

Formunuzun kod bölümüne aşağıdaki kodu ekleyip deneyiniz.

Kod: 
Private Sub ComboBox1_Change()
    If ComboBox1 <> "" And ComboBox2 <> "" Then
        With Sheets("Sayfa3")
            For X = 2 To .Range("A65536").End(3).Row
                If .Cells(X, 1) = ComboBox1 And .Cells(X, 2) = ComboBox2 Then
                    TextBox1 = .Cells(X, 3)
                    Exit For
                End If
            Next
        End With
    End If
End Sub
 
Private Sub ComboBox2_Change()
    If ComboBox1 <> "" And ComboBox2 <> "" Then
        With Sheets("Sayfa3")
            For X = 2 To .Range("A65536").End(3).Row
                If .Cells(X, 1) = ComboBox1 And .Cells(X, 2) = ComboBox2 Then
                    TextBox1 = .Cells(X, 3)
                    Exit For
                End If
            Next
        End With
    End If
End Sub
Genişletmek için tıkla ...

Korhan hocam çok teşekkür ederim. Çözüm yönteminiz çok harika.
Sanırım öğrenmek istediğim yöntem ile verdiğim örnek birbiri ile pek uygun değildi. Hakkınızı helal ediniz.
Aslında select case ile örneklemek istediğim combobox2 deki veriye göre farklı 2 sütundan veri almaktı.
Örnek: ComboBox1 de seçilen Tertip bilgisine göre, ComboBox2 deki veri m.21-f ve m.22-d ise B sütunundan gerekli olan bilgiyi TextBox'a yüklesin değilse C sütunundan bilgiyi yüklesin.
 

Ekli dosyalar

s.savas' Alıntı:
Örnek: ComboBox1 de seçilen Tertip bilgisine göre, ComboBox2 deki veri m.21-f ve m.22-d ise B sütunundan gerekli olan bilgiyi TextBox'a yüklesin değilse C sütunundan bilgiyi yüklesin.
Genişletmek için tıkla ...

Aşağıdaki gibi olabilir:

("Combobox1" de bulunan koda gerek yok)

Kod: 
 Private Sub ComboBox2_Change()
    If ComboBox1 <> "" And ComboBox2 <> "" Then
    b = 3
  [COLOR="Red"]  Select Case ComboBox2.ListIndex
    Case 4 
    b = 2
    Case 6
    b = 2
    End Select[/COLOR]
        With Sheets("Sayfa3")
            For X = 2 To .Range("A65536").End(3).Row
                  If .Cells(X, 1) = ComboBox1 Then
                  TextBox1 = .Cells(X, [COLOR="Red"]b[/COLOR])
                    Exit For
                    End If
            Next
        End With
    End If
End Sub

veya kırmızı bölüm.

Kod: 
   Select Case ComboBox2.ListIndex
    Case 4 , 6
    b = 2
    End Select
 
Son düzenleme:
Husgvarna' Alıntı:
Aşağıdaki gibi olabilir:

("Combobox1" de bulunan koda gerek yok)

Kod: 
 Private Sub ComboBox2_Change()
    If ComboBox1 <> "" And ComboBox2 <> "" Then
    b = 3
    Select Case ComboBox2.ListIndex
    Case 4 
    b = 2
    Case 6
    b = 2
    End Select
        With Sheets("Sayfa3")
            For X = 2 To .Range("A65536").End(3).Row
                  If .Cells(X, 1) = ComboBox1 Then
                  TextBox1 = .Cells(X, b)
                    Exit For
                    End If
            Next
        End With
    End If
End Sub
Genişletmek için tıkla ...

Arkadaşım teşekkür ederim.
Kodun çalışma mantığı hakkında da bilgi verirsen sevinirim.
 
s.savas' Alıntı:
Arkadaşım teşekkür ederim.
Kodun çalışma mantığı hakkında da bilgi verirsen sevinirim.
Genişletmek için tıkla ...


b = 3 'b değişkenini 3 olarak "TextBox1 = .Cells(X, b)" bölümünde sütun numarası olarak kullanılmak üzere;

Select Case ComboBox2.ListIndex 'comboya alınan verinin sıra numarasını seçiyoruz (sizin formda combo "0" dan "8" e kadar sıralanıyor.(userformdaki Comboboxta "Çerçeve" kelimesinin index no "0", "m.21-f" index no 4 olur.))

Case 4 'combo dan seçilen verinin sıra no'su "4" ise "b=2" olacak
b = 2
Case 6 'combo dan seçilen verinin sıra no'su "6" ise "b=2" olacak
b = 2
End Select
 
Arkadaşım tekrar teşekkür ederim.
Sizin kodu ekteki belgeme uyarlamakta sorun yaşıyorum.
 

Ekli dosyalar

s.savas' Alıntı:
Arkadaşım tekrar teşekkür ederim.
Sizin kodu ekteki belgeme uyarlamakta sorun yaşıyorum.
Genişletmek için tıkla ...

Önceki dosyanızla bu dosya bayağı farklı; önceki mesajlarınıza ve yeni dosyadaki "form"dan çıkan sonuca göre
Örneğin:
"2011_BÜTÇESİ" "B" sütununda arama yapılacak "combo2" değer "m.21-f", "m.22-d" ise "L" sütundan değilse "M" sütunundan veri alınacak gibi

Kod: 
Private Sub ComboBox2_Change()
Dim Bul As Range, Sayfa As String
Sayfa = Left(Sheets("Sabit").Range("F1"), 4)

    If ComboBox1 <> "" And ComboBox2 <> "" Then
    b = 13 '"M" sütunu
    Select Case ComboBox2.Value
    Case "m.21-f", "m.22-d"  'combo value "m.21-f", "m.22-d" ise
    b = 12 '"L" sütunu
    End Select
        With Sheets(Sayfa & "_BÜTÇESİ")
            For x = 10 To .Range("B65536").End(3).Row
                  If .Cells(x, 2) = ComboBox1 Then
                  TextBox5 = .Cells(x, b)
                  TextBox5.Value = FormatCurrency(.Cells(x, b).Value, 2)
                    Exit For
                    End If
            Next
        End With
    End If
End Sub
 
Arkadaşlar bu yönteme alternatif olarak, yazılacak yeni bir kod ile bütçelerin grup olarak kalan ödeneğini bulmak istiyorum.
Sheets(Sayfa & "_BÜTÇESİ") isimli sayfanın A10 hücresinden itibaren bütçe kodlarına, grup tanımlaması yapılmıştır.
ComboBox2 de "m.21-f" ve "m.22-d" seçili ise ComboBox1 de görüntülenen bütçenin grubuna ait kalan ödenek tutarının TextBox5 de görüntülenmesi gerekiyor.

Gruplara ait kalan ödenek tutarları ise;
Sheets(Sayfa & "_BÜTÇESİ") isimli sayfanın L7 hücresi M grubunu, L8 hücresi H grubunu ve L9 hücreside Y grubunun kalan ödenek tutarını gösteriyor.
Bilgi ve tecrübesini paylaşacak herkese teşekkür ederim.
 
Merhaba arkadaşlar.
Husgvarna üstadın yazmış olduğu aşağıdaki koda,
Select Case ComboBox2.Value
Case "m.21-f", "m.22-d" den sonra checkbox1 işaretli ise b=12 yerine diğer kodun çalışmasını nasıl sağlarız.

Kod: 
Private Sub ComboBox2_Change()
Dim Bul As Range, Sayfa As String
Sayfa = Left(Sheets("Sabit").Range("F1"), 4)

    If ComboBox1 <> "" And ComboBox2 <> "" Then
    b = 13 '"M" sütunu
    Select Case ComboBox2.Value
    Case "m.21-f", "m.22-d"  'combo value "m.21-f", "m.22-d" ise
    b = 12 '"L" sütunu
    End Select
        With Sheets(Sayfa & "_BÜTÇESİ")
            For x = 10 To .Range("B65536").End(3).Row
                  If .Cells(x, 2) = ComboBox1 Then
                  TextBox5 = .Cells(x, b)
                  TextBox5.Value = FormatCurrency(.Cells(x, b).Value, 2)
                    Exit For
                    End If
            Next
        End With
    End If
End Sub
Kod: 
Select Case ComboBox1.Value

'Mal alımları
Case "253-02 Makineler ve Aletler Grubu" _
, "253-03 Cihazlar ve Aletler Grubu" _
, "255-01 Döşeme ve Mefruşat Grubu" _
, "255-02 Büro Makineleri Grubu" _
, "255-03 Mobilyalar Grubu" _
, "255-07 Kütüphane Demirbaşları Grubu" _
, "255-08 Eğitim Demirbaşları Grubu" _
, "255-09 Spor Amaçlı Kullanılan Demirbaşlar Grubu" _
, "255-10 Güvenlik, Kontrol ve Tedbir Amaçlı Demirbaşlar Grubu" _
, "255-11 Demirbaş Niteliğindeki Süs Eşyaları" _
, "255-12 Kullanımda Olan Demirbaş Niteliğindeki Değerli Eşyalar" _
, "255-99 Diğer Demirbaşlar Grubu" _
, "267-01 Yazılımlar" _
, "740-01 Kırtasiye Malzemeleri Grubu" _
, "740-02 Beslenme/Gıda Amaçlı ve  Mutfakta Kullanılan Tüketim Malzemeleri Grubu" _
, "740-03 Tıbbi ve Laboratuvar Sarf Malzemeleri Grubu" _
, "740-04 Yakıtlar, Yakıt Katkıları ve Katkı Yağlar Grubu" _
, "740-05 Temizleme Ekipmanları Grubu" _
, "740-06 Giyecek, Mefruşat ve Tuhafiye Malzemeleri Grubu" _
, "740-07 İçecek Grubu", "740-08 Yiyecek Grubu", "740-12 Bakım Onarım ve Üretim Malzemeleri Grubu" _
, "740-13 Yedek Parçalar Grubu" _
, "740-14 Nakil Vasıtaları Lastikleri Grubu" _
, "740-15 Değişim, Bağış ve Satış Amaçlı Yayınlar Grubu" _
, "740-16 Spor Malzemeleri Grubu", "740-17 Basınçlı Ekipmanlar", "740-99 Diğer Tüketim Amaçlı Malzemeler"

TextBox5 = Sheets(Sayfa & "_BÜTÇESİ").Range("l7")
TextBox5.Value = FormatCurrency(TextBox5, 2)

'Hizmet Alımları
Case "740-104 Ulaştırma ve Haberleşme Giderleri" _
, "740-105 Taşıma ve Ardiye Giderleri" _
, "740-106 Temizlik Hizmet Alım Giderleri" _
, "740-107 Yemek Hizmet Alım Giderleri" _
, "740-108 Veri Hazırlama ve Bilgi işlem Hizmeti Giderleri" _
, "740-109 Güvenlik Hizmeti Alım Giderleri" _
, "740-110 Çamaşırhane Hizmeti Alım Giderleri" _
, "740-111 Makine Teçhizat ve Tıbbi Cihaz Onarım Giderleri" _
, "740-119 Görüntüleme Hizmeti Alım Giderleri" _
, "740-120 Laboratuar Hizmeti Alım Giderleri" _
, "740-123 Diğer Hizmet Alım Giderleri"
TextBox5 = Sheets(Sayfa & "_BÜTÇESİ").Range("l8")
TextBox5.Value = FormatCurrency(TextBox5, 2)

'Yapım İşleri
Case "253-01 Tesisler Grubu" _
, "740-114 Yapı Tesis Onarım Hizmeti Giderleri" _
, "740-115 İnşaat Maliyet Giderleri"
TextBox5 = Sheets(Sayfa & "_BÜTÇESİ").Range("l9")
TextBox5.Value = FormatCurrency(TextBox5, 2)

End Select
 

Ekli dosyalar

Aşağıdaki şekilde deneyebilirsiniz.

Kod: 
Private Sub CheckBox1_Click()
ComboBox2.Value = ""
End Sub


Private Sub ComboBox2_Change()
Dim Bul As Range, Sayfa As String
Sayfa = Left(Sheets("Sabit").Range("F1"), 4)

   If ComboBox1 <> "" And ComboBox2 <> "" Then
    b = 13 '"M" sütunu
    Select Case ComboBox2.Value
    Case "m.21-f", "m.22-d"  'combo value "m.21-f", "m.22-d" ise
    If CheckBox1.Value = True Then
    grup
    Exit Sub
    End If
   b = 12 '"L" sütunu
    End Select
        With Sheets(Sayfa & "_BÜTÇESİ")
            For x = 10 To .Range("B65536").End(3).Row
                  If .Cells(x, 2) = ComboBox1 Then
                  TextBox5 = .Cells(x, b)
                  TextBox5.Value = FormatCurrency(.Cells(x, b).Value, 2)
                    Exit For
                    End If
            Next
        End With
    End If
 
End Sub


Sub grup()
Sayfa = Left(Sheets("Sabit").Range("F1"), 4)
Select Case ComboBox1.Value
'Mal alımları
Case "253-02 Makineler ve Aletler Grubu" _
, "253-03 Cihazlar ve Aletler Grubu" _
, "255-01 Döşeme ve Mefruşat Grubu" _
, "255-02 Büro Makineleri Grubu" _
, "255-03 Mobilyalar Grubu" _
, "255-07 Kütüphane Demirbaşları Grubu" _
, "255-08 Eğitim Demirbaşları Grubu" _
, "255-09 Spor Amaçlı Kullanılan Demirbaşlar Grubu" _
, "255-10 Güvenlik, Kontrol ve Tedbir Amaçlı Demirbaşlar Grubu" _
, "255-11 Demirbaş Niteliğindeki Süs Eşyaları" _
, "255-12 Kullanımda Olan Demirbaş Niteliğindeki Değerli Eşyalar" _
, "255-99 Diğer Demirbaşlar Grubu" _
, "267-01 Yazılımlar" _
, "740-01 Kırtasiye Malzemeleri Grubu" _
, "740-02 Beslenme/Gıda Amaçlı ve  Mutfakta Kullanılan Tüketim Malzemeleri Grubu" _
, "740-03 Tıbbi ve Laboratuvar Sarf Malzemeleri Grubu" _
, "740-04 Yakıtlar, Yakıt Katkıları ve Katkı Yağlar Grubu" _
, "740-05 Temizleme Ekipmanları Grubu" _
, "740-06 Giyecek, Mefruşat ve Tuhafiye Malzemeleri Grubu" _
, "740-07 İçecek Grubu", "740-08 Yiyecek Grubu", "740-12 Bakım Onarım ve Üretim Malzemeleri Grubu" _
, "740-13 Yedek Parçalar Grubu" _
, "740-14 Nakil Vasıtaları Lastikleri Grubu" _
, "740-15 Değişim, Bağış ve Satış Amaçlı Yayınlar Grubu" _
, "740-16 Spor Malzemeleri Grubu", "740-17 Basınçlı Ekipmanlar", "740-99 Diğer Tüketim Amaçlı Malzemeler"

TextBox5 = Sheets(Sayfa & "_BÜTÇESİ").Range("l7")
TextBox5.Value = FormatCurrency(TextBox5, 2)

'Hizmet Alımları
Case "740-104 Ulaştırma ve Haberleşme Giderleri" _
, "740-105 Taşıma ve Ardiye Giderleri" _
, "740-106 Temizlik Hizmet Alım Giderleri" _
, "740-107 Yemek Hizmet Alım Giderleri" _
, "740-108 Veri Hazırlama ve Bilgi işlem Hizmeti Giderleri" _
, "740-109 Güvenlik Hizmeti Alım Giderleri" _
, "740-110 Çamaşırhane Hizmeti Alım Giderleri" _
, "740-111 Makine Teçhizat ve Tıbbi Cihaz Onarım Giderleri" _
, "740-119 Görüntüleme Hizmeti Alım Giderleri" _
, "740-120 Laboratuar Hizmeti Alım Giderleri" _
, "740-123 Diğer Hizmet Alım Giderleri"
TextBox5 = Sheets(Sayfa & "_BÜTÇESİ").Range("l8")
TextBox5.Value = FormatCurrency(TextBox5, 2)

'Yapım İşleri
Case "253-01 Tesisler Grubu" _
, "740-114 Yapı Tesis Onarım Hizmeti Giderleri" _
, "740-115 İnşaat Maliyet Giderleri"
TextBox5 = Sheets(Sayfa & "_BÜTÇESİ").Range("l9")
TextBox5.Value = FormatCurrency(TextBox5, 2)

End Select
End Sub


Kodları kısaltmak için "ComboBox1.ListIndex" i kullanabilirsiniz.
Kod: 
   Sub grup()

Sayfa = Left(Sheets("Sabit").Range("F1"), 4)
Select Case ComboBox1.ListIndex
Case 1 To 20, 37 To 40
TextBox5 = Sheets(Sayfa & "_BÜTÇESİ").Range("l7")
TextBox5.Value = FormatCurrency(TextBox5, 2)
Case 23 To 29, 33, 35, 36
TextBox5 = Sheets(Sayfa & "_BÜTÇESİ").Range("l8")
TextBox5.Value = FormatCurrency(TextBox5, 2)
Case 0, 31, 32
TextBox5 = Sheets(Sayfa & "_BÜTÇESİ").Range("l9")
TextBox5.Value = FormatCurrency(TextBox5, 2)

End Select
End Sub
 
Son düzenleme:
Üstat yazdığın kodu frmRAPOR isimli sayfada da kullanmak istiyorum. Kodu aşağıdaki gibi revize ettim;

ComboBox1 de Bütçe Kodu ve ComboBox2 de Alım Yöntemi seçildiği zaman "m.21-f" ve "m.22-d" haricindeki alım türlerine ait bilgiler Label126 ve Label129'a gelmektedir. Fakat "m.21-f" ve "m.22-d" seçilince Label126 ya istenen veri gelmekte, Label129'a ise veri gelmemektedir.

Kod: 
Private Sub ComboBox2_Change()
Dim Bul As Range, Sayfa As String
Sayfa = Left(Sheets("BÜTÇE_KODU").Range("D1"), 4)

If ComboBox1 <> "" And ComboBox2 <> "" Then
b = 5
Select Case ComboBox2.Value
    Case "m.21-f", "m.22-d"
If frmANAMENÜ.CheckBox1.Value = True Then
grup
    Exit Sub
End If

b = 4
End Select
        With Sheets(Sayfa & "_BÜTÇESİ")
            For x = 10 To .Range("B65536").End(3).Row
                  If .Cells(x, 2) = ComboBox1 Then
                  Label126.Caption = FormatCurrency(.Cells(x, b).Value, 2)
                    Exit For
             End If
            Next
        End With
    End If
 
If ComboBox1 <> "" And ComboBox2 <> "" Then
b = 13
Select Case ComboBox2.Value
    Case "m.21-f", "m.22-d"
If frmANAMENÜ.CheckBox1.Value = True Then
grup1
    Exit Sub
End If
   
b = 12
End Select
        With Sheets(Sayfa & "_BÜTÇESİ")
            For x = 10 To .Range("B65536").End(3).Row
                  If .Cells(x, 2) = ComboBox1 Then
                  Label129.Caption = FormatCurrency(.Cells(x, b).Value, 2)
                    Exit For
             End If
            Next
        End With
    End If
 
End Sub

Sub grup()
Sayfa = Left(Sheets("BÜTÇE_KODU").Range("D1"), 4)
Select Case ComboBox1.ListIndex
Case 1 To 23, 32, 42, 47 To 53, 55 To 56
Label126.Caption = FormatCurrency(Sheets(Sayfa & "_BÜTÇESİ").Range("D7").Value, 2)

Case 24 To 31, 33 To 36, 41, 43 To 46, 54
Label126.Caption = FormatCurrency(Sheets(Sayfa & "_BÜTÇESİ").Range("D8").Value, 2)

Case 0, 37, 38
Label126.Caption = FormatCurrency(Sheets(Sayfa & "_BÜTÇESİ").Range("D9").Value, 2)

End Select
End Sub

Sub grup1()
Sayfa = Left(Sheets("BÜTÇE_KODU").Range("D1"), 4)
Select Case ComboBox1.ListIndex
Case 1 To 23, 32, 42, 47 To 53, 55 To 56
Label129.Caption = FormatCurrency(Sheets(Sayfa & "_BÜTÇESİ").Range("L7").Value, 2)

Case 24 To 31, 33 To 36, 41, 43 To 46, 54
Label129.Caption = FormatCurrency(Sheets(Sayfa & "_BÜTÇESİ").Range("L8").Value, 2)

Case 0, 37, 38
Label129.Caption = FormatCurrency(Sheets(Sayfa & "_BÜTÇESİ").Range("L9").Value, 2)

End Select
End Sub
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst