Bir sütundaki değerlere göre hücreleri birleştirme

[apostraf]

merhaba arkadaşlar,

ekte örnek dosyada da yazdığım gibi bende 2 sütunluk bir excel dosyası var A sütununda rakamlar B sütununda da metinler var A daki tüm aynı değerlere tekabül eden satırdaki B sütununda bulunan hücrelerin birleştirilmesi ve mümkünse diğer satırların silinmesi/temizlenmesini gerektiren bir çalışmam var içinden çıkamadım.

bu işlemi yapabilecek bir excel fonksiyonu var mı? Şimdiden teşekkür ederim.

 

[asi_kral]

Merhaba
Boş bir module kopyalayın ve deneyin

Option Explicit
Sub birleştir()
Dim STR As Long, BUL As Range, SBT As Variant, VR As String
Application.ScreenUpdating = False
Range("C:C").ClearContents
Range("A:A").AdvancedFilter xlFilterCopy, Range("A:A"), _
Range("C1"), True
With WorksheetFunction
For STR = Cells(Rows.Count, "C").End(xlUp).Row To 1 Step -1
If .CountIf(Range("C1:C" & STR), Cells(STR, "C")) = 1 Then
VR = ""
Set BUL = Range("A:A").Find(Cells(STR, "C"), , , xlWhole)
If Not BUL Is Nothing Then
SBT = BUL.Address
Do
If VR = "" Then
VR = Cells(BUL.Row, "B") & " "
Else
VR = VR & Cells(BUL.Row, "B") & " "
End If
Set BUL = Range("A:A").FindNext(BUL)
Loop While Not BUL Is Nothing And BUL.Address <> SBT
End If
Cells(STR, "E") = VR
Cells(STR, "D") = .VLookup(Cells(STR, "C"), Range("A:B"), 2, 0)
Else
Range("C" & STR & ":E" & STR).Delete Shift:=xlUp
End If
Next
End With
Range("A:B").Delete xlToLeft
Application.ScreenUpdating = True
End Sub

Not : Öncelikle dosyanızın bir yedeğini alıp kodu öyle deneyiniz.

 

[apostraf]

sayın asi_kral,

Çok teşekkür ederim kod çalıştı.

 

[asi_kral]

sayın asi_kral,

Çok teşekkür ederim kod çalıştı.

Kolay Gelsin.