düşeyara bul birleştirme

[mergul]

merhabalar ben ekteki dosyada açıkladıgım üzere düşeyara bul birleştir tarzında formül yada makro olarak yardımlarınızı bekliyorum şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

TABLO isimli sayfanızın adı üzerinde sağ klik yapın ve KOD GÖRÜNTÜLE seçeneğini seçin. Açılan pencereye aşağıdaki kodu uygulayın.

K1 hücresinden ayı seçip sonucu gözlemleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("K1")) Is Nothing Then Exit Sub
    Range("C2:H" & Cells(Rows.Count, 1).End(3).Row).ClearContents
    Set S1 = Sheets("GİRİŞ")
    Set BUL = S1.Range("F:F").Find(Target, , , xlWhole)
    If Not BUL Is Nothing Then
        Adres = BUL.Address
        Do
            Set X = Columns(2).Find(BUL.Offset(0, -2), , , xlWhole)
            Set Y = Rows(1).Find(BUL.Offset(0, -1), , , xlWhole)
            If Not X Is Nothing And Not Y Is Nothing Then
                If Cells(X.Row, Y.Column) = "" Then
                    Cells(X.Row, Y.Column) = BUL.Offset(0, -4)
                Else
                    Cells(X.Row, Y.Column) = Cells(X.Row, Y.Column) & "," & BUL.Offset(0, -4)
                End If
                Cells(38, Y.Column) = Cells(38, Y.Column) + 1
            End If
            Set BUL = S1.Range("F:F").Find(BUL.Value, BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> Adres
    End If
End Sub

 

[mergul]

Korhan bey ilginize çok teşekkür ederim. tam istedigim gibi olmuş....
Acaba tabloda h sütunu ile 38. satırdaki toplamlara hücrelerdeki karar sayılarını toplatmamız mümkün mü? (mesela bir hücrede 4 sayı var ise onları da 4 olarak toplayabilmeli)
olmazsa onları ben formülle deneyebilirim...ellerinize saglık.

 

[Korhan Ayhan]

Merhaba,

Üstteki mesajımdaki kodu revize ettim. Tekrar deneyiniz.

 

[mergul]

Korhan bey denedim ama toplamlar fazla çıkıyor, birde h sütununda satır toplamı yani çift taraflı toplam olabilir mi? ancak sizlerden ögrenmek mümkün birde kodda yer alan "S1" neyi ifade ediyor? tekrar teşekkürler

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

"S1" değişkeni "GİRİŞ" sayfasını ifade ediyor.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("K1")) Is Nothing Then Exit Sub
    Range("C2:H" & Cells(Rows.Count, 2).End(3).Row).ClearContents
    Set S1 = Sheets("GİRİŞ")
    Set BUL = S1.Range("F:F").Find(Target, , , xlWhole)
    If Not BUL Is Nothing Then
        Adres = BUL.Address
        Do
            Set X = Columns(2).Find(BUL.Offset(0, -2), , , xlWhole)
            Set Y = Rows(1).Find(BUL.Offset(0, -1), , , xlWhole)
            If Not X Is Nothing And Not Y Is Nothing Then
                If Cells(X.Row, Y.Column) = "" Then
                    Cells(X.Row, Y.Column) = BUL.Offset(0, -4)
                Else
                    Cells(X.Row, Y.Column) = Cells(X.Row, Y.Column) & "," & BUL.Offset(0, -4)
                End If
                Cells(38, Y.Column) = Cells(38, Y.Column) + 1
                Cells(38, "H") = Cells(38, "H") + 1
                Cells(X.Row, "H") = Cells(X.Row, "H") + 1
            End If
            Set BUL = S1.Range("F:F").Find(BUL.Value, BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> Adres
    End If
End Sub

 

[mergul]

Korhan bey, aynı hücre içindeki birden fazla olan sayıları toplama dahil etmiyor, hücreyi bir sayı olarak topluyor mesela c2 ve c7 hücrelerinde birden fazla sayı var,onları toplama dahil etmiyor birde toplamın kesişimi olan h38 de sütun toplamı ve alt toplamda tam toplama yapmıyor, size de zahmet verdim, tekrar çok teşekkür ederim...

 

[Korhan Ayhan]

Ben tam olarak hangi sonucu görmek istediğinizi anlamadım. Örnek dosya üzerinde sonuçların kaç çıkması gerektiğini elle yazarak açıklarmısınız.

 

[mergul]

Korhan bey dosyayı ekledim, ilginize tekrar teşekkür ederim...

 

[Korhan Ayhan]

#6 nolu mesajımdaki kodu revize ettim. Denermisiniz.

 

[mergul]

Korhan bey süper olmuş, size ne kadar teşekkür etsem azdır. beni büyük bir yükten kurtardınız. muhteşemsiniz, herşey gönlünüzce olsun, tekrar ilginize teşekkür ederim...