En Çok Satan Ürünleri Gruplama

[mukoli]

Merhabalar ektedeki makro amacına uygun çalışıyor fakat yavaş 7500 ürün var tabi bu dahada fazla olabilir hızlandırma şansımız varmıdır. Yada başka çözüm bulabilcek daha hızlı bir şekilde çalışacak şekilde üstadlarımdan yardım bekliyorum teşekkür ederim şimdiden

 

[ÖmerFaruk]

en çok satan ürün A ürünü diyelim ve 199 tane satsın.
trendyol da 100 tane ve costa da 99 tane satmış

Bu durumda istediğiniz sonuç tablosunda
A ürünü tek satırda mı yer alacak yoksa 2 satırda mı?

 

[mukoli]

Ömer hocam teşekkür ederim şimdiden , 2 satırda olsa daha iyi olur hocam hangi pazaryeri ne kadar görmem için

 

[ÖmerFaruk]

Soruyu anlatamadım sanırım. Gerçi siz de anlatamadınız. 1-1 oldu

Şimdi hangi pazar yerine ait olursa olsun toplam satışı en yüksek olan 30 ürünü listelemek istiyorsunuz
Listelerken de hem toplam adedi hem de hangi pazar yerinde kaç tane satılmışsa onları D:I sütunlarında da yazsın istiyorsunuz doğru mudur?

 

[mukoli]

Evet ömer hocam doğrudur

 

[ÖmerFaruk]

Aşağıdaki kodları boş bir module içine ekleyip kullanabilirsiniz.

Sub RaporAl()
   Dim i As Integer, Say As Integer, Dict As Object, Magaza As Object, Arr, Liste()
   Arr = Worksheets("Sayfa1").Range("A1").CurrentRegion.Value
   If UBound(Arr) < 2 Then Exit Sub
   Set Dict = CreateObject("Scripting.Dictionary")
   Set Magaza = CreateObject("Scripting.Dictionary")
   Set SortArr = CreateObject("System.Collections.ArrayList")
   For i = 2 To UBound(Arr)
      If Not SortArr.Contains(Arr(i, 4)) Then SortArr.Add Arr(i, 4)
   Next i
   SortArr.Sort
  
   ReDim Liste(1 To UBound(Arr), 1 To 3 + SortArr.Count)
   For i = 1 To 3
      Liste(1, i) = Arr(1, i)
   Next i
   Say = 1
   For i = 1 To SortArr.Count
      Liste(Say, i + 3) = SortArr(i - 1)
      Magaza.Add SortArr(i - 1), i
   Next i
   For i = 2 To UBound(Arr)
      If Not Dict.Exists(Arr(i, 1)) Then
         Say = Say + 1
         Dict.Add Arr(i, 1), Say
         Liste(Say, 1) = Arr(i, 1)
         Liste(Say, 2) = Arr(i, 2)
      End If
      Liste(Dict(Arr(i, 1)), 3) = Liste(Dict(Arr(i, 1)), 3) + Arr(i, 3)
      Liste(Dict(Arr(i, 1)), 3 + Magaza(Arr(i, 4))) = Liste(Dict(Arr(i, 1)), 3 + Magaza(Arr(i, 4))) + Arr(i, 3)
   Next i
   Set Sh = Worksheets("Rapor")
   Sh.Cells.ClearContents
   Sh.Range("A1").Resize(Say, UBound(Liste, 2)) = Liste
   Sh.Range("A1").Resize(Say, UBound(Liste, 2)).Sort Key1:=Sh.Range("C1"), Order1:=xlDescending, Key2:=Sh.Range("A1"), Order2:=xlAscending, Header:=xlYes
   If Say > 31 Then
      i = 0
      Do
         i = i + 1
      Loop While Worksheets("Rapor").Range("C31") = Worksheets("Rapor").Range("C31").Offset(i, 0)
      Worksheets("Rapor").Range("A31").Offset(i, 0).Resize(Say - 30 - i, UBound(Liste, 2)).ClearContents
   End If
   Set Dict = Nothing: Set ArrSort = Nothing: Set Magaza = Nothing: Erase Liste: Erase Arr: i = Empty: Say = Empty
End Sub

 

[mukoli]

Ömer hocam çok teşekkür ederim ellerinize sağlık sorunsuz, hızlı bir şekilde çalışıyor

 

[mukoli]

Ömer hocam bu kodun bir sınırı varmıdır satır sınırı gibi

 

[ÖmerFaruk]

Dim i As Long
yaparsanız sanırım sınırla kalmayacaktır

 

[mukoli]

Teşekkür ederim

 

[mukoli]

Merhaba ömer hocam şimdi bugun kodu çalıştırırken

 Worksheets("Rapor").Range("A31").Offset(i, 0).Resize(Say - 30 - i, UBound(Liste, 2)).ClearContents

burda hata almaktayım yardımcı olursanız sevinirim teşekkür ederim

 

[ÖmerFaruk]

O satırı şu şekilde değiştirip kullanabilirsiniz.

Worksheets("Rapor").Range("A" & 31 + i, "F" & Rows.Count).ClearContents

 

[mukoli]

Teşekkür ederim ömer hocam