Soru Ürün Çalışması Ürünleri Ana Sayfa Toplama

Katılım
2 Temmuz 2022
Mesajlar
9
Excel Vers. ve Dili
2016, Türkçe
Değerli hocalarım şimdi burada ki veriler kola ve Pepsi olarak ürünlerimi yazacağım ana sayfa iki tane buton olacak makro ile Pepsi ve kola diye hangisine basarsam burada ki hangi veri altında ise o kısım direk gelsin mesela Pepsi bastım veri 1 5 9 12 11 diyelim buradaki alt alta en az 4 tane Pepsi yazan veriler gelsin veya en az 4 tane kola tıkladım hangi veri içinde ise o verileri ana sayfaya getirisin

Dosya
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Ben yazdıklarınızdan da dosyanızdan da ne yapmak istediğinizi anlamadım maalesef. inşallah anlayan biri çıkar ya da siz daha açık bir şekilde anlatırsınız.
 
Katılım
2 Temmuz 2022
Mesajlar
9
Excel Vers. ve Dili
2016, Türkçe
Ben yazdıklarınızdan da dosyanızdan da ne yapmak istediğinizi anlamadım maalesef. inşallah anlayan biri çıkar ya da siz daha açık bir şekilde anlatırsınız.
Sayın hocam öncelikle özür dilerim anlatamadığım için

Şimdi veri olan kısımları ben elle gireceğim veri kısmı işimiz orada değil ana sayfa olan yere makro ile 2 makro olacak hocam orada mantık şu kola ve Pepsi kola

Kola tıkladığım zaman 20 tane veri içinde alt alt olan kısımda Pepsi diyelim üst üste 4 defa yazılmış o kısım Veri kaçta ise ana sayfa getirisin

Örnek

En az 4 kola ve 4 Pepsi kuralı yani üst üste gelmesi lazım

Diyelim 1 3 4 5 6 14 bu verilerin altında alt alta 4 tane Pepsi gelmiş Pepsi kısmına gelsin bunlar

Aynı şekilde kola içinde 2 7 9 11 19 verileri kola destekliyor 4 yane alt alta kola var onları da kola altına gelsin
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Farklı bir çözüm olarak Ana sayfadaki hücre birleştirmeyi iptal edin, yani A1 ve G1 hücreleri başka hücrelerle birleşik olmasın.

Aşağıdaki kodları Ana 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ın.

A1 ya da G1 hücresini seçtiğinizde istediğiniz işlem yapılacaktır. Aktarımın nasıl yapılacağını belirtmediğiniz için aynı sütunda alt alta olacak şekilde ayarladım:


PHP:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set s1 = Sheets("VERİ ")
If Intersect(Target, [A1:E2,G1:K2]) Is Nothing Then Exit Sub
Application.EnableEvents = False
    For sut = 1 To 20
        For sat = 3 To 12
            If WorksheetFunction.CountIf(s1.Range(s1.Cells(sat, sut), s1.Cells(sat + 3, sut)), Target.Value) = 4 Then
                yeni = WorksheetFunction.Max(Cells(Rows.Count, Target.Row).End(3).Row + 1, 3)
                s1.Range(s1.Cells(2, sut), s1.Cells(15, sut)).Copy Cells(yeni, Target.Row)
            End If
        Next
    Next
Application.EnableEvents = True
Target.Offset(0, 1).Select
End Sub
 
Son düzenleme:
Katılım
2 Temmuz 2022
Mesajlar
9
Excel Vers. ve Dili
2016, Türkçe
hocam bu şekilde hepsini alt alta getiriyor koşulu sağlamadı :( çok özür dilerim hocam yani ben anlamatamdım sanırım @YUSUF44

mantık şu mesela 20 tane veri içinde ilk 3 tane önemli ilk 3 tane aynı alt alt ise mesela veri 1 2 3 4 5 karşılıyor bunları getirisn keza diğer koşulu da 11 12 14 9 karşılıyor bunları getirsin
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Tam olarak anlatamayınca öyle oluyor maalesef. Şu anda çıkmam lazım. Bu arada siz istediğiniz sonuç nasılsa ona uygun olarak dosyanızı düzenleyip paylaşın ki vakit kaybetmeyelim.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki gibi deneyin:

PHP:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
Set s1 = Sheets("VERİ ")
If Intersect(Target, [A1]) Is Nothing Then GoTo 10
Application.EnableEvents = False
    [A3:G6].ClearContents
    sutun = 1
    For sut = 1 To 20
        If WorksheetFunction.CountIf(s1.Range(s1.Cells(3, sut), s1.Cells(5, sut)), Target.Value) = 3 Then
            s1.Range(s1.Cells(2, sut), s1.Cells(5, sut)).Copy Cells(3, sutun)
            sutun = sutun + 1
            If sutun = 8 Then GoTo son
        End If
    Next
Application.EnableEvents = True
10:
If Intersect(Target, [K1]) Is Nothing Then Exit Sub
Application.EnableEvents = False
    [J3:S6].ClearContents
    sutun = 10
    For sut = 1 To 20
        If WorksheetFunction.CountIf(s1.Range(s1.Cells(3, sut), s1.Cells(5, sut)), Target.Value) = 3 Then
            s1.Range(s1.Cells(2, sut), s1.Cells(5, sut)).Copy Cells(3, sutun)
            sutun = sutun + 1
            If sutun = 16 Then GoTo son
        End If
    Next
son:
Application.EnableEvents = True
Target.Offset(0, 1).Select
End Sub
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Eyvallah.

Ancak ilk mesajınıza dönüp baktığımda istediğiniz çözümle şimdi istediğiniz ve çözüldüğünü belirttiğiniz sorun arasında epey farklılık olduğunu da belirtmek isterim:

İlk mesajınızda alt alta 4 tane aynı veriden olması gerektiğinden bahsetmiştiniz ama şimdi sadece ilk 3 veri aynıysa diye çözüm istediniz. Ayrıca sonuçların nasıl listelenmesi gerektiğini de belirtmemiştiniz.

Bunlara şunun için dikkat çekmek istiyorum: bundan sonraki sorularınızda ne istediğinizi daha net bir şekilde belirtin ve örnek dosyanızı da bu isteğinize uygun olarak hazırlayın ki çözüme daha kolay ulaşabilelim.

İyi çalışmalar.
 
Katılım
2 Temmuz 2022
Mesajlar
9
Excel Vers. ve Dili
2016, Türkçe
Eyvallah.

Ancak ilk mesajınıza dönüp baktığımda istediğiniz çözümle şimdi istediğiniz ve çözüldüğünü belirttiğiniz sorun arasında epey farklılık olduğunu da belirtmek isterim:

İlk mesajınızda alt alta 4 tane aynı veriden olması gerektiğinden bahsetmiştiniz ama şimdi sadece ilk 3 veri aynıysa diye çözüm istediniz. Ayrıca sonuçların nasıl listelenmesi gerektiğini de belirtmemiştiniz.

Bunlara şunun için dikkat çekmek istiyorum: bundan sonraki sorularınızda ne istediğinizi daha net bir şekilde belirtin ve örnek dosyanızı da bu isteğinize uygun olarak hazırlayın ki çözüme daha kolay ulaşabilelim.

İyi çalışmalar.
Öncelikle çok özür dilerim benim hatamdan kaynaklı oldu bundan sonra daha dikkatli bir şekilde konu açar soru belirtirim sayın hocam tekrardan kusuruma bakmayın lütfen 🙏
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Estağfurullah, yeni bir üye olarak bunu bilemezdiniz elbette ama uygulamalı olarak görmüş oldunuz.
 
Üst