Stok numarasına göre değer bulma

[bulento5]

Merhaba,
İlgili macroda hangi veriyi hangi satırdan alacağı gibi küçük değişiklikler yaptım ve sorunsuz bir şekilde çalışıyor.
İlave olarak bir eklenti daha yapmak mümkünmü acaba?
ekte yer alan macro stok no satırında alt alta tekrarlayan var ise diğer yan satırlarda bulunan açıklamaları "AT" hücresinde tek hücre olacak şekilde düzenliyor.
ilave olarak yapmak istediğim şey "K"kolonunda yer alan KALİTE HATASİ-BİLGİ BLOKESİ-EKSİK ÜRÜN-DENEME gibi açıklamalar yer almakta bunlar herbir
stok numarası için aynıda olabilir veya her satırda bir diğeri de yer alabilir.Tam olarak istediğim bir önceki macrom AT kolonuna aynı olanları
tek hücre olacak şekilde birleştiriyor.Hemen yan satırlara aşağıda yer alan kurallar çerçevesinde tek bir tanımlama olacak şekilde yazdırmak mümkünmü acaba?
örnek bir dosya ekledim.
şimdiden yardımlarınız için çok teşekkürler.


http://s6.dosya.tc/server11/nbimgd/H.xlsx.html

"B" kolonunda yer alan stok numaralara göre "K"kolonunda yer alan kelimelere göre "AU"kolonuna yazacak

*Eğer stok no satırı tek ise K kolonundaki metin aynı olacak(birden fazla tekrar eden stok no satırı aynı metine sahip ise)

*Eğer Kalite hatası-Eksik Ürün-Deneme-Bilgi blokesi metni var ise "Eksik ürün-Kalite hatası" yazacak.

*Eğer Kalite hatası-Deneme-Bilgi blokesi var ise "Kalite hatası" yazacak.

*Eğer Kalite hatası-Eksik Ürün ifadesi var ise "Eksik ürün-Kalite hatası" yazacak.

Mevcut kullandığım macro:

Sub AYNILARI_BIRLESTIR()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
son = Cells(Rows.Count, 1).End(xlUp).Row: Range("AS:AS").ClearContents
brn = 0
For sat = 2 To son
    If WorksheetFunction.CountIf(Range("B:B"), Cells(sat, 2)) = 1 Then
    Cells(sat, 46) = Cells(sat, 10):
    GoTo 10
    Else
        Range("A1:AS1").AutoFilter Field:=2, Criteria1:=Cells(sat, 2)
            For Each brn In Range("J" & sat + 1 & ":J" & son).SpecialCells(xlCellTypeVisible)
                satt = brn.Row
                metin = metin & Chr(10) & brn.Value
            Next
        Cells(sat, 46) = Cells(sat, 10) & metin
        metin = "": sat = satt
    End If
10:
Next
Range("A1:AS1").AutoFilter Field:=2
Columns("A:AS").AutoFit
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem Tamamlandı.", vbInformation, "..::..Ömer Baran ..::.."
End Sub

[URL="http://s6.dosya.tc/server11/nbimgd/H.xlsx.html"]http://s6.dosya.tc/server11/nbimgd/H.xlsx.html[/URL]