Bölge Sorunu

Katılım
15 Nisan 2010
Mesajlar
15
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
11-10-2020
Elimde bir excel verisi var dünya haritası üzerinde kıtalara yaptığım satılşları içeren. Birde bu kıtalara ait ülkelerin verileri var. Üst tarafta o kıta-bölyeyi seçtiğimde aşşağısında bana o kıtaya bağlı ülkelerin litesini getirmesini istiyorum. Meslea asya seçtiğimde alt tarafta japonya-çin-malezya gibi veriler gelsin.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Sizce bu isteğiniz örnek dosya olmadan çözülebilir mi?
 
Katılım
15 Nisan 2010
Mesajlar
15
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
11-10-2020
Acemiliğimi mazur görün altın üyelik için başvurdum da daha onaylanmadı sanırım onaylanır onaylanmaz dosyayı yükleyeceğim
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Merhaba.

Sayfayı sağ tıklatıp Kod Görüntüle seçin.

Aşağıdaki kodu açılan sayfaya kopyalayın.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("B2:B9")) Is Nothing Then
        Dim Say As Long
        Say = Cells(Rows.Count, "A").End(3).Row
        Range("A12:L12").AutoFilter
        Range("$A$12:$L$" & Say).AutoFilter Field:=1, Criteria1:=Target.Text
    End If
End Sub
B2 - B9 aralığında bir seçim yaptığınızda işlem gerçekleştirilecektir.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodları ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırırsanız, [B2:B9] aralığında bir hücreye tıkladığınızda o hücredeki bölgeye göre filtreleme yapar:

PHP:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [B2:B9]) Is Nothing Then Exit Sub
    If Target = "" Then Exit Sub
    If Selection.Count > 1 Then Exit Sub
    son = Cells(Rows.Count, "B").End(3).Row
    Range("A12:L" & son).AutoFilter
    
    ActiveSheet.Range("$A$12:$L$" & son).AutoFilter Field:=1, Criteria1:=Target

End Sub
 

maliex

Altın Üye
Katılım
22 Eylül 2019
Mesajlar
227
Excel Vers. ve Dili
professional plus 2016-türkçe
Altın Üyelik Bitiş Tarihi
23-09-2025
üstadım merhaba

End(3).Row "3" neyi ifade ediyor ?

Merhaba.

Sayfayı sağ tıklatıp Kod Görüntüle seçin.

Aşağıdaki kodu açılan sayfaya kopyalayın.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("B2:B9")) Is Nothing Then
        Dim Say As Long
        Say = Cells(Rows.Count, "A").End(3).Row
        Range("A12:L12").AutoFilter
        Range("$A$12:$L$" & Say).AutoFilter Field:=1, Criteria1:=Target.Text
    End If
End Sub
B2 - B9 aralığında bir seçim yaptığınızda işlem gerçekleştirilecektir.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Son dolu satırın satır numarası.
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Cells(Rows.Count, "A").End(3).Row

Rows.Count: Kaçıncı satıra kadar saymasını istiyorsak o rakamı yazmalıyız. Rows.count son satıra kadar say demektir. Son satır = 1048576 eski excel versiyonunda satır sayısı değiştiği için rakam yerine Rows.count yazıyoruz.
"A": A kolonu sayılır.
end: son
3= xlup :belirtilen hücreden yukarıya doğru ilk dolu hücre demektir.

buna göre aşağıdaki şekilde de yazılabilir.

Cells(1048576, "A").End(3).Row
Daha kısa ifade ile A sütununun 1048576 satırından başlamak üzere (xlup) yukarıya doğru bak ilk dolu hücrenin adresini ver.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Verdiğim kodda End sub satırından önce aşağıdaki kodları eklerseniz seçilen satırı sarı yapar:

Kod:
    [B2:L9].Interior.Color = xlNone
    Range("B" & Target.Row & ":L" & Target.Row).Interior.Color = vbYellow
 

maliex

Altın Üye
Katılım
22 Eylül 2019
Mesajlar
227
Excel Vers. ve Dili
professional plus 2016-türkçe
Altın Üyelik Bitiş Tarihi
23-09-2025
harikasınız çok teşekkür ederim
 
Katılım
15 Nisan 2010
Mesajlar
15
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
11-10-2020
öncelikle yusuf bey ve dalgalikur bey çok teşşekkür ederim sorunumu mükkemmel bir şekilde çözüme kavuşturduduğunuz için. Son bir sorum olacak herhangi bir boşluğa tıkladığımızda formülden çıkıp tam listeyi de göstermek için ne yapmam gerekiyor.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki gibi deneyin. B2:B9 dışında bir yeri seçtiğinizde işlem iptal olur:

PHP:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    son = Cells(Rows.Count, "B").End(3).Row
    If Not Intersect(Target, [B2:B9]) Is Nothing Then
        If Target = "" Then Exit Sub
        If Selection.Count > 1 Then Exit Sub
        Range("A12:L" & son).AutoFilter
        
        ActiveSheet.Range("$A$12:$L$" & son).AutoFilter Field:=1, Criteria1:=Target
        [B2:L9].Interior.Color = xlNone
        Range("B" & Target.Row & ":L" & Target.Row).Interior.Color = vbYellow
    Else
        ActiveSheet.Range("$A$12:$L$" & son).AutoFilter Field:=1
        [B2:L9].Interior.Color = xlNone
        Exit Sub
    End If
End Sub
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Şu kodları kullanın.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("B2:B9")) Is Nothing Then
        Dim Say As Long
        Say = Cells(Rows.Count, "A").End(xlDown).Row
        Range("A12:L12").AutoFilter
        Range("$A$12:$L$" & Say).AutoFilter Field:=1, Criteria1:=Target.Text
    Else
        On Error Resume Next
        ShowAllData
    End If
End Sub
 
Son düzenleme:
Katılım
15 Nisan 2010
Mesajlar
15
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
11-10-2020
üstanlar önünüzde saygıyla eğiliyorum. Tekrardan ellerinize sağlık çok teşekkür ederim.
 
Üst