Alt alta olan satırları karşılaştırma/birleştirme

[Maximillian]

Merhabalar,

Yardımcı olabilirseniz çok sevinirim. Makro ile yapmak istediğim şey:


Alt alta olan satırlar karşılaştırılacak. A, B, C, D, G, I ve K sütunlardaki değerler(metin veya sayı) eşitse geri kalanını karşılaştırmaya devam edecek. Eşit Değilse karşılaştırmayı bırakacak (hiçbir işlem yapmayacak).

Farklılık gördüğü sütundaki değerleri birleştirerek bu iki satırı tek bir satır olarak sayfa 2 ye kaydedecek.Aynı sütunlar için birleştirme yapmadan yalnızca bir tanesini alacak.

Bu işlemi A sütunundan X sütununa kadar alt alta iki satır için yapacak. Mesela A15:X15 ve A16:X16 arasında

Teşekkürler, iyi çalışmalar

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Karsilasti()
 
    Dim S1 As Worksheet, S2 As Worksheet, sonsut As Integer, sut As Integer
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
 
    sonsut = S1.Cells(3, Columns.Count).End(xlToLeft).Column
 
    Application.ScreenUpdating = False
    S2.Rows(3).ClearContents
 
    sut = 1
    For i = 1 To sonsut
        If S1.Cells(3, i) = S1.Cells(4, i) Then
            S2.Cells(3, sut) = S1.Cells(3, i)
            sut = sut + 1
        Else
            S2.Cells(3, sut) = S1.Cells(3, i) & S1.Cells(4, i)
            S1.Range(S1.Cells(3, i + 1), S1.Cells(3, sonsut)).Copy S2.Cells(3, sut + 1)
            Exit For
        End If
    Next i
 
    Application.ScreenUpdating = True
 
End Sub

.

 

[Maximillian]

Tam olarak bu değil ama değişiklikler ile bayağı bir yol katettim. Yol gösterici oldu teşekkür ederim.

 

[isteobenim]

Merhaba,

Ek örnek dosyada belirttiğim gibi, sütunda aynı olan değerlerin alt alta farklı olan değerlerin 7 satır alta aktarılmasını nasıl yapabiliriz.
Mevcut makro ile standart 7 satır alta aktarabiliyorum,

Yardımlarınız için şimdiden teşekkür ederim,