Aynı koda karşılık gelen farklı sütundaki satırları birleştirmek

[YENERB]

Merhabalar,

Aynı koda karşılık gelen farklı sütundaki satırları birleştirmek istiyorum. Fakat burada kod sırası değiştikçe değişen koda ait satırların birleşitirlmesi gerekli. Yardımcı olabilirseniz sevinirim.

Saygılarımla,

YenerB

(Birleşitirilmek istenen satır sayıları kod bazında farklılık gösteriyor)

Örnek:

Kod Alan İstenen
2100 A A
2100 B AB
2100 C ABC
2101 A A
2101 B AB
2103 A A
2103 B AB
2103 C ABC
2103 D ABCD


2100

 

[mancubus]

Sub met_bir()

Dim ws As Worksheet
Dim i As Long
Dim met As String

Set ws = Worksheets("veriler") ' verilerin bulunduğu sayfa ismi

With ws
    .Range("A1").CurrentRegion.Sort _
        Key1:=.Range("A2"), Order1:=xlAscending, _
        Key2:=.Range("B2"), Order2:=xlAscending, _
        Header:=xlYes
    i = 2
    Do
        If .Cells(i, "A") = .Cells(i - 1, "A") Then
            met = met & .Cells(i, "B").Value
        Else
            met = .Cells(i, "B")
        End If
        .Cells(i, "C") = met
        i = i + 1
    Loop While .Cells(i, "A") <> ""
End With

End Sub

 

[YENERB]

Teşekkür ederim...

For-next üzerine denemeler yaptım do loop ta da işin içinden çıkamamıştım. Çok teşekkür ederim çok büyük katkınız oldu. Saygılarımla,

 

[mancubus]

rica ederim.


öyle de olur.

Sub met_bir()

Dim ws As Worksheet
Dim i As Long
Dim met As String

Set ws = Worksheets("veriler") ' verilerin bulunduğu sayfa ismi

With ws
    .Range("A1").CurrentRegion.Sort _
        Key1:=.Range("A2"), Order1:=xlAscending, _
        Key2:=.Range("B2"), Order2:=xlAscending, _
        Header:=xlYes
    For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
        If .Cells(i, "A") = .Cells(i - 1, "A") Then
            met = met & .Cells(i, "B").Value
        Else
            met = .Cells(i, "B")
        End If
        .Cells(i, "C") = met
    Next
End With

End Sub