Verileri ayıklayıp toplama

[irfancantr]

Kolay gelsin;

Ekli dosyamda bulunan genel sayfasında koçan numaraları var ve bunun yan sütununda ne kadar satış yapıldığı yazıyor,bir koçandan birden fazla bulunabiliyor ve farklı satış rakamlarına sahip, ben bu koçanları 100 rakamına eşitmi değil mi tek tek bakmak zorunda kalıyorum

Burada yapmak istediğim örn: 660 numaralı koçandan 10 defa satış yapılsada koçan takip sayfasına tek 600 ve karşısına ne kadar satış yapıldığını yazdırmak.

İlgilenen arkadaşlara şimdiden çok teşekkür ederim.

 

[Orion1]

Dosyanız ektedir.

Option Base 1
Sub kocan_59()
Dim z As Object, a(), i As Long, sayi As Long
Sheets("koçan takip").Select
Range("D3:E65536").ClearContents
Application.ScreenUpdating = False
Set z = CreateObject("Scripting.dictionary")
a = Range("A3:B" & Cells(65536, "A").End(xlUp).Row).Value
For i = 1 To UBound(a)
    If IsNumeric(a(i, 1)) Then
        sayi = Int(a(i, 1) / 100) * 100
        If Not z.exists(sayi) Then
            z.Add sayi, a(i, 2)
            Else
            z.Item(sayi) = z.Item(sayi) + a(i, 2)
        End If
    End If
Next i
Range("D3").Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[halit3]

bu kodu denermisiniz.

Sub aktar()
sat = 3
Sheets("koçan takip").Range("A3:B65500").ClearContents
For r = 6 To Worksheets("genel").Cells(Rows.Count, "B").End(3).Row
aranan1 = Sheets("genel").Cells(r, 2).Value
say1 = 0
If Sheets("genel").Cells(r, 2).Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("genel").Range("B6:B" & r), aranan1) = 1 Then
For i = r To Worksheets("genel").Cells(Rows.Count, "B").End(3).Row
aranan2 = Sheets("genel").Cells(i, 2).Value
If aranan2 = aranan1 Then
say1 = say1 + CDbl(Sheets("genel").Cells(i, 5).Value)
End If
Next i
Sheets("koçan takip").Cells(sat, 1).Value = Sheets("genel").Cells(r, 2).Value
Sheets("koçan takip").Cells(sat, 2).Value = say1
sat = sat + 1
End If
End If
Next r
MsgBox "İşlem tamam"
End Sub

 

[halit3]

geç kalmışım
Evren bey sorunuza cevap vermiş

banimkide alternatif olsun

 

[Orion1]

geç kalmışım
Evren bey sorunuza cevap vermiş

banimkide alternatif olsun

Sizinki farklı bir soru için olmuş.Benimkide sinkinden farklı.Yani sonuçları farklı.:cool.

 

[irfancantr]

Çok teşekkür ederim sayın üstadlar; yalnız evren hocam

sayi = Int(a(i, 1) / 100) * 100

burada bir sıkıntı mı var anlayamadım hata verdi.

 

[Orion1]

Çok teşekkür ederim sayın üstadlar; yalnız evren hocam

sayi = Int(a(i, 1) / 100) * 100

burada bir sıkıntı mı var anlayamadım hata verdi.

A sütununda verilerin arasında sayı değeri olamayan içinde metin olan br hücre var.Bu hata o yüzden oluşur.
Ben dosyayı ekladim.Koduda bu durumu göz önüne lacak şekilde düzenledim.
Dosya 2 numaralı mesajdadır.