[Çözüldü]  listede belli aralıklar içindeki yinelenenleri kaldırma

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

listede belli aralıklar içindeki yinelenenleri kaldırma

İleti#1)  mosquito0031 » 13 Mar 2019 10:51

Merhaba arkadaşlar,
Başlıkta sadece yinelenenleri kaldırma olarak belirtebilsem de biraz daha çetrefilli bir liste var elimde.
Örnek dosya üzerinde görebileceğiniz gibi birden çok kişi ve ürünlerinin sıralandığı bir listem var.
Sıra no, üretici başına sabit olarak düzenlendiği için onu anahtar olarak seçebiliriz.
Sıra no aynı olan satırlar içerisinde geçerli olacak şekilde; yinelenen verileri kaldırmak, benzersizleri ise virgül ile ayırarak tek hücreye yazdırmak istiyorum. (B,C,D,E,F,G sütunları için)
Sayısal veri olan sutünların ise toplanıp tek satırda gözükmesini istiyorum. (H,I sutünları için)
Kısaca her üreticinin 1 satırda gözükmesini istiyorum.
Daha önce de benzer bir talebim olmuş ve pivot tablo ile çözebileceğim söylenmişti fakat bir kuruma bu veriler gönderilecek ve kurum kesinlikle bu şekilde talep ediyor, o nedenle pivot tablo şeklinde kullanamıyorum.
1. Sayfada örnek liste, 2. sayfada da istediğim son örnek bulunmaktadır.
Şimdiden teşekkür ederim.
İyi günler dilerim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
mosquito0031
 
Adı Soyadı:Can AKAR
Kayıt: 27 Ekm 2008 01:33
Konum: Ankara
Meslek: Mühendis
Yaş: 37
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara/Ankara

Cevap: listede belli aralıklar içindeki yinelenenleri kaldır

İleti#2)  veyselemre » 13 Mar 2019 11:32

Örnek sayfanızda sıra numaralarının ardışık olması gerekir.
Kod: Tümünü seç
Sub test()
    Set s1 = Sheets("ÖRNEK")
    Set s2 = Sheets("İSTENEN ÇIKTI")

    s1.Select
    sonSat = Cells(Rows.Count, 1).End(3).Row
    mx = WorksheetFunction.Max(Range("A2:A" & sonSat))
   
    If mx < 1 Then Exit Sub
   
    ReDim liste(1 To mx, 1 To 9)
   
    For i = 2 To sonSat
        sira = Cells(i, 1)
        If sira > islenen Then
            islenen = sira
            For ii = 1 To 9
                liste(sira, ii) = Cells(i, ii)
            Next ii
        Else
            If InStr(liste(sira, 6), Cells(i, 6)) = 0 Then
                liste(sira, 6) = liste(sira, 6) & ", " & Cells(i, 6)
            End If
            liste(sira, 8) = liste(sira, 8) + Cells(i, 8)
            liste(sira, 9) = liste(sira, 9) + Cells(i, 9)
        End If
    Next i
   
    s2.Select
    Range("A2:I" & Rows.Count).Clear
    With [a2].Resize(mx, 9)
        .Value = liste
        .EntireColumn.AutoFit
        .Borders.LineStyle = xlContinuous
    End With
   
End Sub
Kullanıcı avatarı
veyselemre
Siteye Alışmış
 
Kayıt: 28 Nis 2015 15:53
Meslek: SERBEST
Yaş: 104
İleti: 358
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çubuk

Cevap: listede belli aralıklar içindeki yinelenenleri kaldır

İleti#3)  mosquito0031 » 13 Mar 2019 12:30

Çok teşekkür ederim kod için.
Kodu çalıştırınca tek satıra düşüyor, köy/mah sütunu (6. Sutun, F sutünu) virgülle ayrılmış şekilde geliyor fakat il,ilçe ve ürün sutünlarında da farklılıklar olduğunda sadece sıra numarasındaki ilk satırdaki veriyi almakta. Onları da eğer benzersiz değer varsa virgüllü şekilde yazdırabilir miyiz? (4,5 ve 7. sutünlar; D,E ve G sütunları)

Yardımlarınız için tekrar teşekkür ederim.
Kullanıcı avatarı
mosquito0031
 
Adı Soyadı:Can AKAR
Kayıt: 27 Ekm 2008 01:33
Konum: Ankara
Meslek: Mühendis
Yaş: 37
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara/Ankara

Cevap: listede belli aralıklar içindeki yinelenenleri kaldır

İleti#4)  Vedat ÖZER » 13 Mar 2019 12:54

Merhaba,

Veysel Hocam sizin çalışmalarınızdan çok yararlanıyorum, Allah razı olsun [mersi]

Hocamızın verdiği koda ekleme yaptım. Deneyebilir misiniz.


Kod: Tümünü seç
Sub test()
    Set s1 = Sheets("ÖRNEK")
    Set s2 = Sheets("İSTENEN ÇIKTI")

    s1.Select
    sonSat = Cells(Rows.Count, 1).End(3).Row
    mx = WorksheetFunction.Max(Range("A2:A" & sonSat))
   
    If mx < 1 Then Exit Sub
   
    ReDim liste(1 To mx, 1 To 9)
   
    For i = 2 To sonSat
        sira = Cells(i, 1)
        If sira > islenen Then
            islenen = sira
            For ii = 1 To 9
                 liste(sira, ii) = Cells(i, ii)

            Next ii
        Else
            If InStr(liste(sira, 6), Cells(i, 6)) = 0 Then
                liste(sira, 6) = liste(sira, 6) & ", " & Cells(i, 6)
            End If
           
            If InStr(liste(sira, 4), Cells(i, 4)) = 0 Then
                liste(sira, 4) = liste(sira, 4) & ", " & Cells(i, 4)
            End If
           
            If InStr(liste(sira, 5), Cells(i, 5)) = 0 Then
                liste(sira, 5) = liste(sira, 5) & ", " & Cells(i, 5)
            End If
           
            If InStr(liste(sira, 7), Cells(i, 7)) = 0 Then
                liste(sira, 7) = liste(sira, 7) & ", " & Cells(i, 7)
            End If
           
            liste(sira, 8) = liste(sira, 8) + Cells(i, 8)
            liste(sira, 9) = liste(sira, 9) + Cells(i, 9)
        End If
    Next i
   
    s2.Select
    Range("A2:I" & Rows.Count).Clear
    With [a2].Resize(mx, 9)
        .Value = liste
        .EntireColumn.AutoFit
        .Borders.LineStyle = xlContinuous
    End With
   
End Sub
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Allah bize yeter, O ne güzel vekildir.

vedatozer@outlook.com
Vedat ÖZER
Forum Moderatörü
 
Adı Soyadı:vedat özer
Kayıt: 12 Haz 2014 15:26
Konum: ANTALYA / KEMER
Meslek: MUHASEBE
Yaş: 28
İleti: 604
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Antalya

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: listede belli aralıklar içindeki yinelenenleri kaldır

İleti#5)  veyselemre » 13 Mar 2019 12:59

Kod: Tümünü seç
Sub test()
    Set s1 = Sheets("ÖRNEK")
    Set s2 = Sheets("İSTENEN ÇIKTI")

    s1.Select
    sonSat = Cells(Rows.Count, 1).End(3).Row
    mx = WorksheetFunction.Max(Range("A2:A" & sonSat))

    If mx < 1 Then Exit Sub

    ReDim liste(1 To mx, 1 To 9)

    For i = 2 To sonSat
        sira = Cells(i, 1)
        If sira > islenen Then
            islenen = sira
            For ii = 1 To 9
                liste(sira, ii) = Cells(i, ii)
            Next ii
        Else
            For ii = 4 To 7
                If InStr(liste(sira, ii), Cells(i, ii)) = 0 Then
                    liste(sira, ii) = liste(sira, ii) & ", " & Cells(i, ii)
                End If
            Next ii
            liste(sira, 8) = liste(sira, 8) + Cells(i, 8)
            liste(sira, 9) = liste(sira, 9) + Cells(i, 9)
        End If
    Next i

    s2.Select
    Range("A2:I" & Rows.Count).Clear
    With [a2].Resize(mx, 9)
        .Value = liste
        .EntireColumn.AutoFit
        .Borders.LineStyle = xlContinuous
    End With

End Sub
Kullanıcı avatarı
veyselemre
Siteye Alışmış
 
Kayıt: 28 Nis 2015 15:53
Meslek: SERBEST
Yaş: 104
İleti: 358
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çubuk

Cevap: Cevap: listede belli aralıklar içindeki yinelenenleri

İleti#6)  veyselemre » 13 Mar 2019 13:07

Vedat ÖZER yazdı:Merhaba,
Veysel Hocam sizin çalışmalarınızdan çok yararlanıyorum, Allah razı olsun [mersi]

Hocalık gibi bir vasfım da kariyerim de yok, amatörce takılıyoruz, vakit geçiriyoruz, stres atmaya çalışıyorum. Allah hepimizden razı olsun, iyi günler dilerim.
Kullanıcı avatarı
veyselemre
Siteye Alışmış
 
Kayıt: 28 Nis 2015 15:53
Meslek: SERBEST
Yaş: 104
İleti: 358
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çubuk

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: listede belli aralıklar içindeki yinelenenleri kaldır

İleti#7)  mosquito0031 » 13 Mar 2019 13:28

Allah razı olsun sizlerden.
Tam istediğim gibi olmuş.
Çok teşekkür ederim.
Kullanıcı avatarı
mosquito0031
 
Adı Soyadı:Can AKAR
Kayıt: 27 Ekm 2008 01:33
Konum: Ankara
Meslek: Mühendis
Yaş: 37
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara/Ankara

Cevap: listede belli aralıklar içindeki yinelenenleri kaldır

İleti#8)  Vedat ÖZER » 13 Mar 2019 13:32

İyi çalışmalar dilerim.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Allah bize yeter, O ne güzel vekildir.

vedatozer@outlook.com
Vedat ÖZER
Forum Moderatörü
 
Adı Soyadı:vedat özer
Kayıt: 12 Haz 2014 15:26
Konum: ANTALYA / KEMER
Meslek: MUHASEBE
Yaş: 28
İleti: 604
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Antalya


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: ASYAASYA, Yenilmez ve 3 misafir

Bumerang - Yazarkafe