3 KOŞULLU DÜŞEYARA + EĞERSAY

[mpextreme]

merhaba,

EK te dosyada;

her TARİH değişiminde
her KOD değişiminde
her PLAKA değişiminde

toplam ADET nedir
kaç SEFER atılmıştır

bunu nasıl hesaplarız?

---------------------------------------------------------------------------
ÖRNEK-1:
01.10.2018 TARİH,
1320 KOD,
34 BDN 740 PLAKA,

toplam ADET 67.500 çıkmalı
SEFER NO 3 ve 4 mevcut görünüyor, bu da 2 sefer atıldığını gösterir
(her sefer no'dan mükerrer görünen rakamlar tek sayacak, yani burada olduğu gibi mükerrer 3 ve 4 ler var ama biz bunu 3 ve 4 olmak üzere 2 SEFER atıldı olarak hesaplayacağız)

---------------------------------------------------------------------------
ÖRNEK-2:
01.10.2018 TARİH,
1320 KOD,
34 HE 5298 PLAKA,

toplam ADET 156.500 çıkmalı
SEFER NO 2, 4, 5 ve 6 mevcut görünüyor, bu da 4 SEFER atıldığını gösterir
(her sıra no'dan mükerrer görünen rakamlar tek sayacak, yani burada olduğu gibi mükerrer 2, 4, 5 ve 6 lar var ama biz bunu 2, 4, 5 ve 6 olmak üzere 4 SEFER hesaplayacağız)

 

[Merhum İdris SERDAR]

.

Dosyanız ekte.

.

 

[halit3]

Alternatif dosya LİSTE sayfasındaki komut düğmesine tıkla

Sub Gruplandir()

ZBasla = TimeValue(Now)
zaman = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual


Set s1 = Sheets("DATA") ' veri sayfası
Set S2 = Sheets("LİSTE") 'aktarılan sayfa

S2.Range("a2:F" & Rows.Count).ClearContents 'Clear
son1 = s1.Cells(Rows.Count, "b").End(3).Row

ReDim ara1(son1): ReDim ara2(son1):: ReDim ara3(10):

For j = 4 To son1
ara1(j) = WorksheetFunction.Trim(s1.Cells(j, "b")) & WorksheetFunction.Trim(s1.Cells(j, "D")) & WorksheetFunction.Trim(s1.Cells(j, "C"))
ara2(j) = 1
Next j

sat1 = 2
For r = 4 To son1
aranan1 = ara1(r)

For t = 1 To 10
ara3(t) = 0
Next t

sut14 = 0
sut15 = 0

If ara2(r) = 1 Then

For i = r To son1
If ara1(i) = aranan1 Then
ara3(s1.Cells(i, "E").Value) = 1
sut15 = sut15 + CDbl(s1.Cells(i, "F").Value)
ara2(i) = 0
End If
Next i
say = 0
For t = 1 To 10
If ara3(t) > 0 Then
say = say + 1
End If
Next t


S2.Cells(sat1, 1).Value = sat1 - 1
S2.Cells(sat1, 2).Value = s1.Cells(r, "B").Value
S2.Cells(sat1, 3).Value = s1.Cells(r, "c").Value
S2.Cells(sat1, 4).Value = s1.Cells(r, "d").Value

S2.Cells(sat1, 5).Value = say
S2.Cells(sat1, 6).Value = sut15

sat1 = sat1 + 1

End If
Next r

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
zBitis = TimeValue(Now)

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"

End Sub