aynı dosyaya ait verileri başka sayfada birleştirme

[gezgin-49]

sayın üstadlarım, ekteki dosyada sayfa 2 de A sütununa dosya numarası yazdığım zaman Sayfa 1'e gitsin oradaki dosya numaraları ile karşılaştırsın, aynı dosya numarasında alt alta kaç tane İnfaz dosya numarası yazılı ise bu sayfada aralarında virgül bırakmak kaydıyla yan yana yazmasını istiyorum.
hepinize saygılarımı sunuyorum.

 

[denemetor]

Sayfa2'deki A sutununu doldurdugunuzda sonuc isimli sayfada istediginiz formatta ciktiyi gorebileceksiniz. Makrolu kaydetmemin sebebi hucre birlestirme islemini kendi yazdigim bir fonksiyon ile yapmis olmam. Bir de dosyanin boyutu 72kb civarlarinda cunku sonuc sayfasi icin 1000 satiri otomatik olarak doldurdum.

 

[gezgin-49]

sayın denemetor ilginiz için teşekkür ederim, ancak sonuç sayfasında istediğim sonuç çıkmıyor, birleştirme işlemi yapmıyor, ayrıca sayfa 2 A hücresinde dosyaları yeniden yazmam çok zor olacak, daha kısa yolu yokmu?

 

[Ömer]

Merhaba,

Bu gibi işlemleri fonksiyonla çözmek için fazlaca yardımcı sütunlar kullanmanız gerekir. Bu yüzden makro kullanmanızı tavsiye ederim.

Sayfa2 nin kod bölümüne kopyalayınız. A sütununa veri girince kod çalışır.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim S1 As Worksheet, c As Range, Adr As String
 
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
 
    Set S1 = Sheets("Sayfa1")
 
    On Error Resume Next
    Target.Offset(0, 1).ClearContents
 
    With S1.Range("A:A")
        Set c = .Find(Target, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                Target.Offset(0, 1) = Target.Offset(0, 1) & ", " & S1.Cells(c.Row, "G")
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With
 
    Target.Offset(0, 1) = WorksheetFunction.Substitute(Target.Offset(0, 1), ", ", "", 1)
 
End Sub

.

 

[gezgin-49]

Sayın üstadım Ömer çok teşekkür ederim, ellerinize, emeğinize sağlık, tam istediğim gibi olmuş,