Ürün dağılımı

[bebar]

Merhaba;

ürünlerin mağaza performanslarına göre dağılımı konusunda sıkıntı yaşamaktayım maalesef pratik bir çözümünü bulamadım

ilgili dosyam ektedir, yardımlarınız için teşekkür ederim.

 

[veyselemre]

Sub dagit()
    oncelik = Range("K3:K" & Cells(Rows.Count, "K").End(3).Row).Value
    Set cekilecek = CreateObject("scripting.dictionary")
    son = Cells(Rows.Count, "A").End(3).Row
    lst = Range("A3:G" & son).Value
    Range("G3:G" & son).ClearContents
    Dim ver
    For i = LBound(lst) To UBound(lst)
        If lst(i, 6) = "Çekilebilir" Then
            Key = lst(i, 1)
            cekilecek(Key) = cekilecek(Key) & lst(i, 2) & "|"
        End If
    Next i

    For i = LBound(lst) To UBound(lst)
        If lst(i, 6) = "Takviye yapılmalı" Then
            Key = lst(i, 1)
            If cekilecek.exists(Key) Then
                ver = cekilecek(Key)
                For Each elem In oncelik
                    If InStr(ver, elem & "|") Then
                        Cells(i + 2, "G").Value = elem
                        cekilecek(Key) = Replace(ver, elem & "|", "")
                        Exit For
                    End If
                Next elem
            End If
        End If
    Next i
End Sub

 

[bebar]

Hocam cok ama cok tesekkur ederım çok faydası oldu
Emeğine sağlık

 

[bebar]

Merhaba;

Oluşturduğunuz makro çok işime yaradı birçok yerde kulladım fakat son oluşturduğum raporda sürekli hata alıyorum nedenini bulamadım yardımcı olursanız sevinirim örnek dosyam ektedir.

Sub dagit()
oncelik = Range("P3" & Cells(Rows.Count, "P").End(3).Row).Value
Set cekilecek = CreateObject("scripting.dictionary")
son = Cells(Rows.Count, "A").End(3).Row
lst = Range("A3:L" & son).Value
Range("L3:L" & son).ClearContents
Dim ver
For i = LBound(lst) To UBound(lst)
If lst(i, 11) = "Çekilebilir" Then "HATA VERDİĞİ YER
Key = lst(i, 1)
cekilecek(Key) = cekilecek(Key) & lst(i, 6) & "|"
End If
Next i

For i = LBound(lst) To UBound(lst)
If lst(i, 11) = "Takviye yapılmalı" Then
Key = lst(i, 1)
If cekilecek.exists(Key) Then
ver = cekilecek(Key)
For Each elem In oncelik
If InStr(ver, elem & "|") Then
Cells(i + 2, "L").Value = elem
cekilecek(Key) = Replace(ver, elem & "|", "")
Exit For
End If
Next elem
End If
End If
Next i
End Sub