Aynı olan satırları yanyana satıra yazma

[ucarkadas]

Merhaba Arkadaşlar

ekteki dosyada yapmak istediğim urunun kodu aynı fakat renkleri farklı bunları bir sutun daha açıp urun kodu aynı olanların karşısındaki renkleri bir satıra toplamak. Bilmiyorum anlatabildimmi,

yardımcı olan veya olacak arkadaşlara şimdiden teşekkür ederim.

 

[Ömer]

Merhaba,

Yan sütuna değil farklı bir bölüme özet çıkarmanız daha mantıklı olur diye düşünüyorum. Module kopyalayıp çalıştırın.

Sub Ozet_Birlestir()
 
    Dim s, a1, a2, deg, i As Long
 
    Application.ScreenUpdating = False
    Range("G:I").ClearContents
 
    With CreateObject("Scripting.Dictionary")
        For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
           deg = Cells(i, "B")
           If Not .exists(deg) Then
               s = Array(Cells(i, "A"), Cells(i, "C"))
               .Add deg, s
           Else
               s = .Item(deg)
               s(1) = s(1) & " " & Cells(i, "C")
               .Item(deg) = s
           End If
        Next i
 
        a1 = .keys: a2 = .items
        For i = 0 To .Count - 1
            s = a2(i)
            Cells(i + 1, "G") = s(0)
            Cells(i + 1, "H") = a1(i)
            Cells(i + 1, "I") = s(1)
        Next i
    End With
 
    Application.ScreenUpdating = True
End Sub

.

 

[pedasabyem]

Sütunda aynı koda sahip hücrelerin bulunduğu satırları yan yana sıralamak

Merhaba,
Öncelikle değerli bilgilerinizi bizlerle paylaştığınız için sizlere teşekkür ederim.
Birkaç gün önce yazacaktım bu mesajı ama hemen soru sormayayım araştırayım dedim fakat pazartesi gününden bu yana uğraştım yapamadım maalesef. Yukarıda verdiğiniz örneği de kendi sayfama uyarlamaya çalışıyorum fakat vb bilmediğim için yapamadım.

Excel dosyalarımda yapmak istediğim aşağıdaki gibi. Ek'teki dosyadan sanırım daha iyi anlaşılacaktır.
A sütunu esas alınacak. A sütununda aynı olan kodların olduğu satırdaki bilgiler, tek satıra yan yana gelmeli. Aynı koda sahip A, B, C, D, E, F hücrelerindeki bilgiler aynı olduğu için birer kere yazılmalı, fakat G, H ve I'daki bilgiler faklı olduğu için 3'er kere (yanyana 9 tane hücre) yan yanyana yazılmalı. VB kodunu çalıştırdıktan sonra işlenmiş bilgi "Sonuc" sayfasına yazmalı.

Yardımcı olabilirseniz çok sevinirim.
Saygılarımla

Not: Ek'teki .xlsx dosyasının resim görünümü de aşağıda verilmiştir.

 

[apocalyt]

bişiler yapmaya çalıştım..eki inceleyin..kolay gelsin..

 

[pedasabyem]

Buna teşekkürden başka ne denilebilir ki, şimdi hemen gerçek dosyamda deneyeceğim bunu. Gerçek dosyalarımdaki satır sayıları 700 000 olan da var 1 milyon satır olan da. Bu yazdığınız kod orada da çalışırsa minnettar kalırım size.
Kod muhtemelen çalışacak. Bir de gerçek dosyam da nasıl ve ne kadar sürede çalışacak.
Hemen denemeliyim
Çok teşekkür ederim apocalyt

 

[pedasabyem]

Bu kodu hızlandıracak şekilde düzenlemenin bir yolu var mıdır acaba?

Tekrar merhaba,

Verdiğiniz kod çalışıyor. Fakat bu sefer de şöyle bir sorun oldu. Kodu çalıştırdım, aradan 1 saat geçti ve henüz 20nci satırda. İnanılmaz yavaş.

Benim excel dosyamda 100binlerce satır var

Bu kodu hızlandıracak şekilde düzenlemenin bir yolu var mıdır acaba?

Sub xxxx()

For x = 2 To Sheets(1).Range("a100000").End(3).Row
For k = 2 To 1000
If Sheets(1).Cells(x, 1) = Sheets(1).Cells(k + x - 1, 1) Then
Z = Z + 1
Else
Sheets(1).Range("a" & x & ":" & "f" & x).Copy
Sheets(2).Range("a10000").End(3).Offset(1, 0).PasteSpecial
b = b + 1
For c = 7 To 7 + Z
Sheets(2).Cells(b + 1, c) = Sheets(1).Range("g" & x)
d = d + 1
Next c
For e = 7 + d To 7 + d + Z
Sheets(2).Cells(b + 1, e) = Sheets(1).Range("h" & x)
f = f + 1
Next e
For y = 7 + d + f To 7 + d + Z + f
Sheets(2).Cells(b + 1, y) = Sheets(1).Range("ı" & x)
Next y

x = x + k - 2
d = 0: Z = 0: f = 0
Exit For
End If
Next k
Next x
Application.CutCopyMode = False

End Sub

 

[apocalyt]

pedasabyem hocam sanırım ben çok fazla değişken kullandım..bundan kaynaklanabilir.belki bunun çok daha kısa bir yolu vardır..ancak bu benim bilgimi aşıyo.. umarım değerli hocalarımızdan biri konuya daha kullanışlı bir kodla çözüm getirir.

 

[Ömer]

Tekrar merhaba,

Verdiğiniz kod çalışıyor. Fakat bu sefer de şöyle bir sorun oldu. Kodu çalıştırdım, aradan 1 saat geçti ve henüz 20nci satırda. İnanılmaz yavaş.

Benim excel dosyamda 100binlerce satır var

Bu kodu hızlandıracak şekilde düzenlemenin bir yolu var mıdır acaba?

Dosyanızda ilk veri 3 kere tekrarlamış, bundan dolayı sizde başlık kısmında 3 sütuna "Diğer-Kod" yazmışsınız. Bu mantıkla farklı bir veride 5 kez tekrarlama olunca sütun başlıklarını birbirini tutmaz.

Öyle değil mi?

Bu şekilde yapmak yerine sütunları aralarında istediğiniz bir ayıraç koyarak ilk mesajdaki gibi her sütun için tek bir başlıkta içe içe yazmak daha mantıklı değil mi?

Ayrıca şartlar sütunu her zaman boş mu?

.