Sütundaki aynı değerleri yan yana sıralama

[esratilla]

Tekrardan Merhaba.

Ekte yolladığım dosyadaki gibi sütun içerisindeki birbirine benzer kodları yan yana sıralatabilir miyiz?Benzer olan kodu koyu renkli yaptım.Ya da benzer kodları nasıl tespit edebilirim?

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu deneyiniz.

Benzer satırlarda "B" sütununa adres yazarak sizi yönlendirir.

Option Explicit

Sub BENZER_BUL()
    Dim Veri As Range, Bul As Range, Adres As String, Veri_Adres As String, Alan As Range
    
    Range("B:B").ClearContents
    
    For Each Veri In Range("A1:A1000")
        If Veri.Value <> "" Then
            If Veri.Offset(0, 1) = "" Then
                Set Bul = Range("A:A").Find(Veri.Value)
                If Not Bul Is Nothing Then
                    Adres = Bul.Address
                    Do
                        If Veri.Address <> Bul.Address Then
                            If Veri_Adres = "" Then
                                Veri_Adres = Veri.Address & "-" & Bul.Address
                            Else
                                Veri_Adres = Veri_Adres & "-" & Bul.Address
                            End If
                                            
                            If Alan Is Nothing Then
                                Set Alan = Bul
                            Else
                                Set Alan = Union(Alan, Bul)
                            End If
                        End If
                        Set Bul = Range("A:A").FindNext(Bul)
                    Loop While Not Bul Is Nothing And Bul.Address <> Adres
                End If
                If Not Alan Is Nothing Then
                    Veri.Offset(0, 1) = Veri_Adres
                    Alan.Offset(0, 1) = Veri_Adres
                    Set Alan = Nothing
                    Veri_Adres = ""
                End If
            End If
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub