• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan YENERB
  • Başlangıç tarihi Başlangıç tarihi
Katılım
2 Eylül 2008
Mesajlar
39
Excel Vers. ve Dili
EXCEL-2007 ENG
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
 
Kod:
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
 
Son düzenleme:
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,
 
rica ederim.


öyle de olur.

Kod:
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
 
Geri
Üst