Excel'de Ayrıştırma Nasıl Yapılır

[Baggwell]

Merhaba,

Ekteki örnekte bir liste mevcut. Formül ya da makro ile izahatleri mağazalara nasıl ayrıştırabilirim ?

 

[sakman26]

selam,
formüllerle yapılmış örnek ektedir.
kolay gelsin..

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .EnableEvents = False
    End With
    
    Dim SD As Worksheet: Set SD = Sheets("Sayfa1")
    Dim SO As Worksheet: Set SO = Sheets("Sayfa1")
    
    ss = SD.Cells(Columns.Count, "F").End(2).Row
    SD.Range(Cells(2, "F"), Cells(Rows.Count,ss)).ClearContents
    
    Dim liste(), dizi()
    son = SD.Cells(Rows.Count, "C").End(3).Row
    liste = SD.Range("C2:D" & son).Value
    Set dic = CreateObject("scripting.dictionary")
    For x = 1 To UBound(liste, 1)
        aranan = liste(x, 1)
        If Not dic.exists(aranan) Then
            dic.Add aranan, ""
        End If
    Next x
    SO.Range("F2").Resize(1, dic.Count) = (dic.keys)
    x = Empty: son = Empty: Erase liste: aranan = Empty
    
    Ssütun = Range("F2").Columns.End(2).Column
    For i = 5 To Ssütun
        ara = SD.Cells(2, i)
        son = SD.Cells(Rows.Count, "C").End(3).Row
        liste = SD.Range("B2:C" & son).Value
        ReDim dizi(1 To son)
        For x = 1 To UBound(liste, 1)
            aranan = liste(x, 2)
            If aranan = ara Then
                n = n + 1
                dizi(n) = liste(x, 1)
            End If
        Next x
        SO.Cells(3, i).Resize(son, 1) = Application.Transpose(dizi)
        aranan = Empty: Erase dizi: n = Empty: son = Empty
    Next i
    With Application
        .ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .EnableEvents = True
    End With
    MsgBox "B i t t i"
End Sub

. . .

 

[baydeniro]

Teşekkürler Hüseyin Çoban