Combobox ile yapılmış bir userform için yardım istiyorum

A

anthraxx02

Katılım
17 Kasım 2019
Mesajlar
39
Excel Vers. ve Dili
2019,Türkçe
Merhabalar Arkadaşlar;

Arkadaşlar dilim döndüğü kadar anlatmaya çalışıyorum

excel sayfasında cinsiyet , marka , ürün ismi, Fiyatı olmak üzere 4 sutun var
userform ile cinsiyet marka seçip ürünü filtreyeyerek ürünün fiyatını değiştirmek istiyorum

deneme yaptım ama bir türlü yapamadım örnek dosyayı ekliyorum

Şimdiden yardımınız için çok teşekkürler

Kitap1.xlsm dosyasını indir - download

Kitap1.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle
s6.dosya.tc s6.dosya.tc
 
ÖmerBey

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,127
Excel Vers. ve Dili
2007 Türkçe
Merhaba,
Userform içindeki kodları aşağıdakilerle değiştirerek deneyiniz...
Not: Cinsiyet ve marka karşılıklı olarak süzme işlemi yapar. Yani; seçtiğiniz cinsiyete uygun markaları, ya da seçtiğiniz markaya uygun cinsiyetleri görebilirsiniz. Sıfırlamak için diğer comboboxu boşaltmalısınız.. Bu özelliği iptal etmek için kırmızı satırı silebilirsiniz...
Rich (BB code): 
Dim dz

Private Sub ComboBox1_Change()
marka
urun
End Sub

Private Sub ComboBox2_Change()
cinsiyet
urun
End Sub

Private Sub ComboBox3_Change()
dz1 = Filter(dz, "|" & ComboBox3.Value & "|", True, vbBinaryCompare)
If UBound(dz1) >= 0 Then TextBox1.Text = CDbl(Split(dz1(0), "|")(3))
End Sub

Private Sub CommandButton1_Click()
dz1 = Filter(dz, "|" & ComboBox3.Value & "|", True, vbBinaryCompare)
If UBound(dz1) >= 0 Then Cells(Split(dz1(0), "|")(4), "D") = CDbl(TextBox1.Text)
tanimla
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
tanimla
cinsiyet
marka
urun
End Sub
Private Sub tanimla()
x = 0
ReDim dz(0)
Set s1 = Sheets("Sayfa1")
For a = 2 To s1.Cells(Rows.Count, 1).End(3).Row
    ReDim Preserve dz(x)
    dz(x) = Join(Application.Transpose(Application.Transpose(s1.Range("A" & a & ":D" & a).Value)), "|") & "|" & a
    x = x + 1
Next
End Sub

Private Sub marka()
Set s = CreateObject("Scripting.Dictionary")
If ComboBox1.Value = "" Then
    dz1 = dz
Else
    dz1 = Filter(dz, ComboBox1.Value & "|", True, vbBinaryCompare)
End If
For a = LBound(dz1) To UBound(dz1)
    If Not s.exists(Split(dz1(a), "|")(1)) Then
        s.Add Split(dz1(a), "|")(1), ""
    End If
Next
If s.Count > 0 Then ComboBox2.List = Application.Transpose(s.keys)
Set s = Nothing
End Sub

Private Sub cinsiyet()
Set s = CreateObject("Scripting.Dictionary")
If ComboBox2.Value = "" Then
    dz1 = dz
Else
    dz1 = Filter(dz, "|" & ComboBox2.Value & "|", True, vbBinaryCompare)
End If
For a = LBound(dz1) To UBound(dz1)
    If Not s.exists(Split(dz1(a), "|")(0)) Then
        s.Add Split(dz1(a), "|")(0), ""
    End If
Next
If s.Count > 0 Then ComboBox1.List = Application.Transpose(s.keys)
Set s = Nothing
End Sub
Private Sub urun()
ComboBox3.Clear
Set s = CreateObject("Scripting.Dictionary")
If ComboBox1 <> "" And ComboBox2 <> "" Then
    dz1 = Filter(dz, ComboBox1.Value & "|" & ComboBox2.Value & "|", True, vbBinaryCompare)
ElseIf ComboBox1.Value <> "" Then
    dz1 = Filter(dz, ComboBox1.Value & "|", True, vbBinaryCompare)
ElseIf ComboBox2 <> "" Then
    dz1 = Filter(dz, "|" & ComboBox2.Value & "|", True, vbBinaryCompare)
Else
    dz1 = dz
End If
For a = LBound(dz1) To UBound(dz1)
    If Not s.exists(Split(dz1(a), "|")(2)) Then
        s.Add Split(dz1(a), "|")(2), ""
    End If
Next
If s.Count > 0 Then ComboBox3.List = Application.Transpose(s.keys)
Set s = Nothing
End Sub
 
A

anthraxx02

Katılım
17 Kasım 2019
Mesajlar
39
Excel Vers. ve Dili
2019,Türkçe
ÖmerBey' Alıntı:
Merhaba,
Userform içindeki kodları aşağıdakilerle değiştirerek deneyiniz...
Not: Cinsiyet ve marka karşılıklı olarak süzme işlemi yapar. Yani; seçtiğiniz cinsiyete uygun markaları, ya da seçtiğiniz markaya uygun cinsiyetleri görebilirsiniz. Sıfırlamak için diğer comboboxu boşaltmalısınız.. Bu özelliği iptal etmek için kırmızı satırı silebilirsiniz...
Rich (BB code): 
Dim dz

Private Sub ComboBox1_Change()
marka
urun
End Sub

Private Sub ComboBox2_Change()
cinsiyet
urun
End Sub

Private Sub ComboBox3_Change()
dz1 = Filter(dz, "|" & ComboBox3.Value & "|", True, vbBinaryCompare)
If UBound(dz1) >= 0 Then TextBox1.Text = CDbl(Split(dz1(0), "|")(3))
End Sub

Private Sub CommandButton1_Click()
dz1 = Filter(dz, "|" & ComboBox3.Value & "|", True, vbBinaryCompare)
If UBound(dz1) >= 0 Then Cells(Split(dz1(0), "|")(4), "D") = CDbl(TextBox1.Text)
tanimla
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
tanimla
cinsiyet
marka
urun
End Sub
Private Sub tanimla()
x = 0
ReDim dz(0)
Set s1 = Sheets("Sayfa1")
For a = 2 To s1.Cells(Rows.Count, 1).End(3).Row
    ReDim Preserve dz(x)
    dz(x) = Join(Application.Transpose(Application.Transpose(s1.Range("A" & a & ":D" & a).Value)), "|") & "|" & a
    x = x + 1
Next
End Sub

Private Sub marka()
Set s = CreateObject("Scripting.Dictionary")
If ComboBox1.Value = "" Then
    dz1 = dz
Else
    dz1 = Filter(dz, ComboBox1.Value & "|", True, vbBinaryCompare)
End If
For a = LBound(dz1) To UBound(dz1)
    If Not s.exists(Split(dz1(a), "|")(1)) Then
        s.Add Split(dz1(a), "|")(1), ""
    End If
Next
If s.Count > 0 Then ComboBox2.List = Application.Transpose(s.keys)
Set s = Nothing
End Sub

Private Sub cinsiyet()
Set s = CreateObject("Scripting.Dictionary")
If ComboBox2.Value = "" Then
    dz1 = dz
Else
    dz1 = Filter(dz, "|" & ComboBox2.Value & "|", True, vbBinaryCompare)
End If
For a = LBound(dz1) To UBound(dz1)
    If Not s.exists(Split(dz1(a), "|")(0)) Then
        s.Add Split(dz1(a), "|")(0), ""
    End If
Next
If s.Count > 0 Then ComboBox1.List = Application.Transpose(s.keys)
Set s = Nothing
End Sub
Private Sub urun()
ComboBox3.Clear
Set s = CreateObject("Scripting.Dictionary")
If ComboBox1 <> "" And ComboBox2 <> "" Then
    dz1 = Filter(dz, ComboBox1.Value & "|" & ComboBox2.Value & "|", True, vbBinaryCompare)
ElseIf ComboBox1.Value <> "" Then
    dz1 = Filter(dz, ComboBox1.Value & "|", True, vbBinaryCompare)
ElseIf ComboBox2 <> "" Then
    dz1 = Filter(dz, "|" & ComboBox2.Value & "|", True, vbBinaryCompare)
Else
    dz1 = dz
End If
For a = LBound(dz1) To UBound(dz1)
    If Not s.exists(Split(dz1(a), "|")(2)) Then
        s.Add Split(dz1(a), "|")(2), ""
    End If
Next
If s.Count > 0 Then ComboBox3.List = Application.Transpose(s.keys)
Set s = Nothing
End Sub
Genişletmek için tıkla ...
Eline koluna emeğine sağlık çok işime yaradı Çok teşekkür ederim
 
ÖmerBey

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,127
Excel Vers. ve Dili
2007 Türkçe
Rica ederim,
İyi çalışmalar diliyorum...
 
A

anthraxx02

Katılım
17 Kasım 2019
Mesajlar
39
Excel Vers. ve Dili
2019,Türkçe
ÖmerBey' Alıntı:
Rica ederim,
İyi çalışmalar diliyorum...
Genişletmek için tıkla ...
ömer bey küçük bir hata ile karşılaştım anlatayım hemen

yazdığınız kod aktif şekilde çalışıyor.Filtreleme kaydetme çalışıyor lakin şöyle bir sıkıntı var kayıt yaparken açık olan sayfaya yapıyor
 
ÖmerBey

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,127
Excel Vers. ve Dili
2007 Türkçe
Kayıt koduna aşağıdaki eklemeyi yapınız...
Rich (BB code): 
Private Sub CommandButton1_Click()
dz1 = Filter(dz, "|" & ComboBox3.Value & "|", True, vbBinaryCompare)
If UBound(dz1) = 0 Then Sheets("Sayfa1").Cells(Split(dz1(0), "|")(4), "D") = CDbl(TextBox1.Text)
tanimla
End Sub
 
A

anthraxx02

Katılım
17 Kasım 2019
Mesajlar
39
Excel Vers. ve Dili
2019,Türkçe
ÖmerBey' Alıntı:
Kayıt koduna aşağıdaki eklemeyi yapınız...
Rich (BB code): 
Private Sub CommandButton1_Click()
dz1 = Filter(dz, "|" & ComboBox3.Value & "|", True, vbBinaryCompare)
If UBound(dz1) = 0 Then Sheets("Sayfa1").Cells(Split(dz1(0), "|")(4), "D") = CDbl(TextBox1.Text)
tanimla
End Sub
Genişletmek için tıkla ...
Teşekkürler
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst