Filtreli Hücrelerde Birleştir Formülü Uygulaması

[d_teke]

Merhabalar,

excel

Linkteki excel dosyasındaki gibi;

E sütunundaki herhangi bir grup kodunu filtrelediğimde (örneğin G000009), B sütunundaki değerlerin, aralarına ";" konularak D1 hücresinde birleştirilmesi için yardımlarınızı rica ediyorum.

Bunu yapmak mümkün müdür?

Konu ile ilgili yardımcı olabilen olursa çok sevinirim.

İlginiz için şimdiden çok teşekkür ediyorum, iyi çalışmalar herkese.

 

[YUSUF44]

Sayfanıza activex denetimlerinden bir adet CommandButton ve bir adet de combobox ekleyin. İsimlerinin CommandButton1 ve ComboBox1 olduğunu varsayarak;
Aşağıdaki kodları ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırın ve combobox'tan seçim yaparak durumu gözlemleyin:

Private Sub ComboBox1_Change()
    If ComboBox1.Value = "" Then Exit Sub
    ActiveSheet.Range("$A$1:$G$1").AutoFilter
    son = Cells(Rows.Count, "E").End(3).Row
    [D1] = ""
    ActiveSheet.Range("$A$1:$G$" & son).AutoFilter Field:=5, Criteria1:=ComboBox1.Value
    For i = 2 To son
        If Cells(i, "E") = ComboBox1.List(ComboBox1.ListIndex) Then
            If [D1] = "" Then
                [D1] = Cells(i, "B")
            Else
                [D1] = [D1] & ";" & Cells(i, "B")
            End If
        End If
    Next
    CommandButton1.Visible = True
    [D1].Select
End Sub

Private Sub ComboBox1_DropButtonClick()
    son = Cells(Rows.Count, "E").End(3).Row
    If CommandButton1.Visible = False Then GoTo 10
    a = Cells(son, "E").Value
10:
    ActiveSheet.Range("$A$1:$G$1").AutoFilter
    son = Cells(Rows.Count, "E").End(3).Row
    ComboBox1.Clear
    For i = 2 To son
        If WorksheetFunction.CountIf(Range("E1:E" & i), Cells(i, "E")) = 1 Then
            ComboBox1.AddItem (Cells(i, "E"))
        End If
    Next
    ComboBox1.Value = a
End Sub

Private Sub CommandButton1_Click()
    ActiveSheet.Range("$A$1:$G$1").AutoFilter
    CommandButton1.Visible = False
    ComboBox1.Value = ""
    [D1] = ""
End Sub

 

[hamitcan]

Bir örnekte benden olsun.

Private Sub Worksheet_Calculate()
    [d1].ClearContents
    x = [a65536].End(3).Row
    For Each hcr In Range("b2:b" & x).SpecialCells(xlCellTypeVisible)
        t = t & hcr.Text & ";"
    Next
    [d1] = t
End Sub

 

[d_teke]

Çok teşekkür ediyorum, iyi çalışmalar.

 

[d_teke]

Çok teşekkür ediyorum, iyi çalışmalar.