tekrar eden hücrelerin, karşısındaki açıklama hücrelerinin içindeki değerleri alt alta tek hücrede birleştirme.

[ridvansahin]

Günaydın herkese,

Elimde uzun bir liste var. Bu listenin A sütununda ürün kodları var. B sütununda ise o ürünün hangi arabaya uyumlu olduğunun açıklamaları yazıyor. A sütunundaki bir ürün tekrar ediyor çünkü o ürün birden fazla arabaya uyumlu olabilir. Bu listede yapmak istediğim şey ; Ürünler listede tekrar etmeden , B sütunundaki araç bilgilerini tek bir hücrede açıklamaları alt alta toplamak.

Örnek dosyayı ekledim. 2. sayfasında da nasıl olması gerektiğini de manuel olarak hazırladım.

Liste çok uzun olduğu için manuel yapamıyorum. Bunun için bir fonksiyona ihtiyacım var.
Yardımlarınızı bekliyorum.
İyi çalışmalar.

 

[YUSUF44]

Office 365 kullandığınızı belirtmişsiniz. Bu durumda yeni formüllerle bu işlemi çözebilirsiniz. Öncelikle istenen formdaki A2:B5 aralığını boşaltın.

A2 hücresine aşağıdaki formülü ekleyin, alttaki hücrelere kendisi ekleyecektir:

=BENZERSİZ(Sayfa1!A2:A12)

B2 hücresine aşağıdaki formülü ekleyin, alttaki hücrelere kendisi ekleyecektir:

=METİNBİRLEŞTİR(DAMGA(10);DOĞRU;FİLTRE(Sayfa1!$B$2:$B$12;Sayfa1!$A$2:$A$12=A2;""))

B sütununu Metni Kaydır olarak biçimlendirin.

 

[ridvansahin]

Office 365 kullandığınızı belirtmişsiniz. Bu durumda yeni formüllerle bu işlemi çözebilirsiniz. Öncelikle istenen formdaki A2:B5 aralığını boşaltın.

A2 hücresine aşağıdaki formülü ekleyin, alttaki hücrelere kendisi ekleyecektir:

=BENZERSİZ(Sayfa1!A2:A12)

B2 hücresine aşağıdaki formülü ekleyin, alttaki hücrelere kendisi ekleyecektir:

=METİNBİRLEŞTİR(DAMGA(10);DOĞRU;FİLTRE(Sayfa1!B2:B12;Sayfa1!A2:A12=A2;""))

B sütununu Metni Kaydır olarak biçimlendirin.

Bu işlem geçerli değil uyarısı verdi.Sizden ricam ekteki dosya üzerine formülleri yazarak yapar mısınız?

 

[ridvansahin]

Office 365 kullandığınızı belirtmişsiniz. Bu durumda yeni formüllerle bu işlemi çözebilirsiniz. Öncelikle istenen formdaki A2:B5 aralığını boşaltın.

A2 hücresine aşağıdaki formülü ekleyin, alttaki hücrelere kendisi ekleyecektir:

=BENZERSİZ(Sayfa1!A2:A12)

B2 hücresine aşağıdaki formülü ekleyin, alttaki hücrelere kendisi ekleyecektir:

=METİNBİRLEŞTİR(DAMGA(10);DOĞRU;FİLTRE(Sayfa1!B2:B12;Sayfa1!A2:A12=A2;""))

B sütununu Metni Kaydır olarak biçimlendirin.

Bu işlem geçerli değil uyarısı verdi.Sizden ricam ekteki dosya üzerine formülleri yazarak yapar mısınız?

Bu arada professional plus 2019 kullanıyorum.

 

[YUSUF44]

Profilinizde office 365 kullandığınız yazıyor. Eğer Office 365 kullanmıyorsanız bu formüller çalışmaz maalesef.

 

[YUSUF44]

Office 365 dışındaki sürünler için aşağıdaki makroyu bir modüle kopyalayıp deneyin. Çalıştırmadan önce Sayfa1'de PARS REF. başlığındaki noktayı silin PARS REF olsun:

Sub raporla()
Dim s1, s2 As Worksheet, arac As String, eski, son, i, j As Integer
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("istenen form")

eski = s2.Cells(Rows.Count, "A").End(3).Row
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)

If eski > 1 Then s2.Range("A2:B" & eski).Clear

Application.ScreenUpdating = False
Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select distinct [PARS REF] from [Sayfa1$] where [PARS REF] is not null"
Set rs = con.Execute(sorgu)
s2.[A2].CopyFromRecordset rs

enson = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "A").End(3).Row)
For i = 2 To enson
    arac = Empty
    For j = 2 To son
        If s1.Cells(j, "A") = s2.Cells(i, "A") Then
            If WorksheetFunction.CountIfs(s1.Range("A1:A" & j), s2.Cells(i, "A"), s1.Range("B1:B" & j), s1.Cells(j, "B")) = 1 Then
                If arac = "" Then
                    arac = s1.Cells(j, "B")
                Else
                    arac = arac & Chr(10) & s1.Cells(j, "B")
                End If
            End If
        End If
    Next
    s2.Cells(i, "B") = arac
Next

s2.Range("A1:B" & enson).VerticalAlignment = xlCenter
s2.Range("A2:B" & enson).HorizontalAlignment = xlLeft
s2.Range("A1:B" & enson).Borders.LineStyle = 1

Application.ScreenUpdating = True
s2.Activate
MsgBox "İşlem tamamlandı", vbExclamation
End Sub

 

[ridvansahin]

maalseef çalışmadı.

 

[ridvansahin]

YAPMAK İSTEDİĞİM DOSYA BUDUR

 

[YUSUF44]

maalseef çalışmadı.

Ben denemediğim makroyu kolay kolay paylaşmam. İlk mesajımdaki formülleri de sonraki makroyu da birinci mesajınızda paylaştığınız dosyada deneyerek oluşturdum ve istediğiniz sonucu aldım. Şimdi evdeki bilgisayarda tekrar yaptım ve aynı şekilde doğru sonuç verdi. Siz bir şeyleri yanlış yapmışsınızdır. Evde yaptıklarımı sırasıyla anlatayım:

Birinci mesajdaki dosyanızı indirdim
Yukarda#6 nolu mesajda verdiğim kodları kopyaladım
Excel dosyanızda VBA bölümüne geçtim
Insert menüsünden module ekledim
Kodları yapıştırdım
Dosyada Sayfa1'de A1 hücresindeki noktayı sildim PARS REF oldu
Makroyu çalıştırdım ve istenen sonucu aldım.
Hatta Sayfa1'e başka satırlar eklediğimde onları da düzgünce aktardı.

Eğer birebir böyle yapmadıysanız böyle yaparak deneyin lütfen.

Şimdi son paylaştığınız dosyayı indirdim ve dosyada sadece sayfa1'in olduğunu, istenen form sayfasının olmadığını gördüm. Ayrıca makroyu da eklememişsiniz. Eğer istenen form sayfası olmayan bir dosyada makroyu denediyseniz hata olması kaçınılmaz, çünkü makronun temeli iki sayfaya dayanıyor. Lütfen makroyu ilk mesajınızdaki dosyada uygulayıp deneyin.

Yeni dosyanızda da verdiğim makroyu ekleyip istenen form sayfasını da ekleyerek çalıştırdığımda makronun düzgün çalıştığını gördüm. Ancak verileriniz biraz çok olduğundan işlemin sonuçlanması uzun sürüyor.

 

[ridvansahin]

O zaman ben soruyu yanlış anlatmışım Hocam. Bendeki veriler ilk sayfadaki gibi. Ben bu verilerin ikinci sayfadaki gibi olmasını istiyorum.

 

[YUSUF44]

Neden anlaşamıyoruz bilmiyorum ama iki dosya paylaştınız. ilk dosyanızda 2 sayfa vardı ve verdiğim office 365 formüllü çözüm de makro da o dosyada tam olarak istediğiniz işlemi yapıyordu. Sonra ikinci dosyayı paylaştınız ve o dosyada sadece bir sayfa var. Şimdi ise ikinci sayfadaki gibi olmasını istiyorsunuz!

Lütfen bir önceki mesajıma göre dosyanızda deneme yapıp sonucunu paylaşın.

 

[ridvansahin]

Yusuf Bey, ilk paylaştığım dosya iki sayfadan ibaret. Bu dosyanın ilk sayfası benim ikinci gönderdiğim tek sayfalı dosya ile aynı formda. Sol tarafta kodlar var. Bu kodlar ürün kodları ve birden çok otomobil için uyumlu olduğundan tekrar ediyor. Benim amacım sol tarafta kodların tekrar etmesini engelleyip , bir kod (bir ürün] kaç farklı otomobil için kullanılıyorsa, bu otomobil bilgilerini B sütunundaki bir hücrenin içine, otomobil markaları başta olacak şekilde (ilk gönderdiğim dosyanın ikinci sayfası) ndaki formu elde etmektir.

 

[YUSUF44]

Lütfen denemeden cevap vermeyin. Asıl verilerinizi ilk dosyanızdaki Sayfa1'e kopyalayın ya da dosyanıza istenen form sayfası ekleyin ve makroyu çalıştırıp deneyin.

 

[ridvansahin]

Şuan dediğiniz şekilde yaptım ve sonuç aldım. Çok TEŞEKKÜRLER.

 

[YUSUF44]

Dünden beri farklı bir şey söylemedim ama anlaşamadık bir türlü.

 

[ridvansahin]

@YUSUF44 Hocam selamlar tekrar.
Yukarıda verdiğiniz kodlar office 365 için çalışıyor mu?
Önceden 2019 için denemiştim olmuştu. Şimdi aynısına yine ihtiyacım var. Ama office 365 kullanıyorum.
Rica etsem kontrol edebilir misiniz?