Makro İle Koşullu benzersiz ürünleri getirme Hk.

[polatsuayip]

Merhaba Üstadlar,

Ekte bulunan excel dosyasında farklı tarihlerde aynı müşteriye aynı ürünleri satabiliyorum haliyle müşteriyi seçtiğimde ona satmış olduğum ürünlerin listesinin gelmesini istiyorum. Ancak gelen listede mükerrer ürünler oluyor. Aynı müşteriye farklı tarihlerde satılan aynı ürünü tek listelemesini nasıl sağlayabilirim. ve liste 20 den fazla sütun 650.000 gibi artarak devam eden satıra sahip. bu yüzden makro istiyorum formülde excel kapanıyor.

Örnek data Link=> Dosya

Saygılarımla
Şuayip

 

[Muzaffer Ali]

Merhaba.
Sayfa adını sağ tıklatın Kod Görüntüle seçin aşağıdaki kodları açılan sayfaya kopyalayın.
J5 hücresinde bir değişiklik olduğunda kodlar çalışacaktır.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    Dim Bak As Range
    Dim SonSatir As Long
    If Intersect(Target, Range("J5")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Range("J6:K" & Rows.Count).ClearContents
    For Each r In Range("C:C").SpecialCells(xlCellTypeConstants)
        If r.Text = Range("J5").Text Then
            On Error Resume Next
            Set Bak = Range("J6:J" & Rows.Count).SpecialCells(xlCellTypeConstants).Find(r(1, 2))
            SonSatir = Cells(Rows.Count, "J").End(3).Row + 1
            If Not Bak Is Nothing Then
                Bak(1, 2) = Bak(1, 2) + r(1, 3)
            Else
                Range("J" & SonSatir) = r(1, 2)
                Range("K" & SonSatir) = r(1, 3)
            End If
        End If
    Next
    Application.EnableEvents = True
End Sub

 

[Orion1]

Alternatif.
Dosyanız linktedir..

Dosyayı indir

Option Base 1
Sub benzersiz_59()
Dim z As Object, sonsat As Long, n As Long
Dim liste(), myarr(), deg As String, i As Long
Range("J6:L" & Rows.Count).ClearContents
liste = Range("C5:E" & Cells(Rows.Count, "C").End(xlUp).Row).Value
Set z = CreateObject("scripting.dictionary")
ReDim myarr(1 To UBound(liste), 1 To 3)
Application.ScreenUpdating = False
For i = 1 To UBound(liste)
    If liste(i, 1) = Range("J5").Value Then
        deg = liste(i, 1) & liste(i, 2)
        If Not z.exists(deg) Then
            n = n + 1
            deg = liste(i, 1) & liste(i, 2)
            z.Add (deg), n
            myarr(n, 1) = liste(i, 1)
        End If
        myarr(z.Item(deg), 2) = liste(i, 2)
        myarr(z.Item(deg), 3) = myarr(z.Item(deg), 3) + liste(i, 3)
    End If
Next i
If z.Count > 0 Then Range("J6").Resize(z.Count, 3) = myarr
Application.ScreenUpdating = True
MsgBox "Bitti."
        
End Sub

 

[polatsuayip]

Üstadlar elinize emeğinize sağlık, atladığım bir detay başka sheetden veri çekeceğim ve ekte üzerinde çalıştığım dosya var iki farklı sheet te miktar ve tutar olarak Satış/iade olmasına göre toplamak istiyorum (sumifs ile toplama işini çözebilirim) aynı makroyu bu dosya içinde formülize edebilirseniz çok sevinirim.

Şimdiden teşekür ederim.

Dosya İndir

Saygılarımla,
Şuayip

 

[Orion1]

Yolladığınız dosyadan bir şey anlamadım.
Diğer sayfalarda başlıkların dışında veri yok!
Oradan veri gelecekse onlarıda düzenlemeniz lazım.

 

[polatsuayip]

Yolladığınız dosyadan bir şey anlamadım.
Diğer sayfalarda başlıkların dışında veri yok!
Oradan veri gelecekse onlarıda düzenlemeniz lazım.

Hocam data sayfasının uzunluğu 650 bin satır oradaki ana cari miktar sheetinde D2 hücresinden metro seçince Miktar sayfasının D8 den aşağıya doğru metroya satılan ürün kodları mükerrer olmadan gelsin istiyorum. miktar ve tutar adlı iki sayfa yaptım birinde miktarı diğerinde satış tutarlarını özetleyeceğim.

excel revize =Revize İndir.
saygılarımla

 

[Muzaffer Ali]

For Each r In Range("C:C").SpecialCells(xlCellTypeConstants)

satırına sayfa adı belirtin yeterli. Aşağıdaki gibi olacak.
"SayfaAdi" yerine verilerin bulunduğu sayfanın adını yazın.

For Each r In worksheet("SayfaAdi")Range("C:C").SpecialCells(xlCellTypeConstants)

 

[Orion1]

Data sayfasında hangi sütunda ürün kodu var?

 

[polatsuayip]

Data sayfasında hangi sütunda ürün kodu var?

AK sütununda ürün kodu
G sütununda da seçtiğim müşteriler var

 

[polatsuayip]

For Each r In Range("C:C").SpecialCells(xlCellTypeConstants)

satırına sayfa adı belirtin yeterli. Aşağıdaki gibi olacak.
"SayfaAdi" yerine verilerin bulunduğu sayfanın adını yazın.

For Each r In worksheet("SayfaAdi")Range("C:C").SpecialCells(xlCellTypeConstants)

Kodu değiştirip denediğim de hata alıyorum üstadım
son gönderdiğim exceli indirip formüle edebilirseniz sevinirim Data sheeti AK sütununda ki ürün kodlarını miktar sayfasına seçilen müşteriye göre getirecek.

 

[Orion1]

Dosyayı ektedir.

 

[polatsuayip]

Dosyayı ektedir.

üstadım link atarsanız sevinirim henüz altın üye olmadım

 

[Orion1]

üstadım link atarsanız sevinirim henüz altın üye olmadım

DOSYAYI INDIR