Sipariş no ve tarihe göre veri arama toplama

[alper81]

Sayın üstadlarım sayfa1 deki tabloda 2 çeşit arama yaptırıp verileri toplamasını nasıl yaptırabilirim. yardımlarınızı bekliyorum

 

[İhsan Tank]

Sayın üstadlarım sayfa1 deki tabloda 2 çeşit arama yaptırıp verileri toplamasını nasıl yaptırabilirim. yardımlarınızı bekliyorum

syn : alper81
dosyanızda nasıl bir işlem istiyorsanız işaretlerseniz

 

[alper81]

ekteki dosyada istediğimi işaretledim ve yazdım. yardımlarınız için teşekkürler

 

[İhsan Tank]

ekteki dosyada istediğimi işaretledim ve yazdım. yardımlarınız için teşekkürler

merhaba
e2 hücresine

=TOPLA.ÇARPIM(('NO 1'!$B$2:$B$32=Sayfa1!$A2)*('NO 1'!$A$2:$A$32=Sayfa1!E$1);('NO 1'!$H$2:$H$32))+TOPLA.ÇARPIM(('NO 2'!$B$2:$B$32=Sayfa1!$A2)*('NO 2'!$A$2:$A$32=Sayfa1!E$1);('NO 2'!$H$2:$H$32))+TOPLA.ÇARPIM(('NO 3'!$B$2:$B$32=Sayfa1!$A2)*('NO 3'!$A$2:$A$32=Sayfa1!E$1);('NO 3'!$H$2:$H$32))+TOPLA.ÇARPIM(('NO 4'!$B$2:$B$32=Sayfa1!$A2)*('NO 4'!$A$2:$A$32=Sayfa1!E$1);('NO 4'!$H$2:$H$32))+TOPLA.ÇARPIM(('NO 5'!$B$2:$B$32=Sayfa1!$A2)*('NO 5'!$A$2:$A$32=Sayfa1!E$1);('NO 5'!$H$2:$H$32))+TOPLA.ÇARPIM(('NO 6'!$B$2:$B$32=Sayfa1!$A2)*('NO 6'!$A$2:$A$32=Sayfa1!E$1);('NO 6'!$H$2:$H$32))+TOPLA.ÇARPIM(('NO 7'!$B$2:$B$32=Sayfa1!$A2)*('NO 7'!$A$2:$A$32=Sayfa1!E$1);('NO 7'!$H$2:$H$32))+TOPLA.ÇARPIM(('NO 8'!$B$2:$B$32=Sayfa1!$A2)*('NO 8'!$A$2:$A$32=Sayfa1!E$1);('NO 8'!$H$2:$H$32))+TOPLA.ÇARPIM(('NO 9'!$B$2:$B$32=Sayfa1!$A2)*('NO 9'!$A$2:$A$32=Sayfa1!E$1);('NO 9'!$H$2:$H$32))+TOPLA.ÇARPIM(('NO 10'!$B$2:$B$32=Sayfa1!$A2)*('NO 10'!$A$2:$A$32=Sayfa1!E$1);('NO 10'!$H$2:$H$32))+TOPLA.ÇARPIM(('NO 11'!$B$2:$B$32=Sayfa1!$A2)*('NO 11'!$A$2:$A$32=Sayfa1!E$1);('NO 11'!$H$2:$H$32))+TOPLA.ÇARPIM(('NO 12'!$B$2:$B$32=Sayfa1!$A2)*('NO 12'!$A$2:$A$32=Sayfa1!E$1);('NO 12'!$H$2:$H$32))

bu formülü yazın
dosya ekte

 

[alper81]

çok teşekkürler ihsan bey sayenizde çok güzel bir hal aldı çok saolun

 

[İhsan Tank]

çok teşekkürler ihsan bey sayenizde çok güzel bir hal aldı çok saolun

rica ederim
iyi çalışmalar :mutlu:

 

[Orion1]

Dosyanız ektedir.
No ile başlayan sayfa adlarınfakilerde işlem yapıldı.

Sub siparis_toplam_59()
Dim sh As Worksheet, i As Long, sat1 As Long, sat2 As Long
Dim z As Object, sut As Integer, myarr(), j As Long, n As Long
Dim col As Collection, myarr2()
Set col = New Collection
Sheets("Sayfa1").Select
sut = Cells(1, "IV").End(xlToLeft).Column
If sut < 4 Then
    MsgBox "Tarih girilmemiş." & vbLf & "İşlem sona erdi", vbCritical, "UYARI"
    Exit Sub
End If
sat1 = Cells(65536, "A").End(xlUp).Row
If sat1 < 2 Then
    MsgBox "Sipariş no girilmemiş" & vbLf & "İşlem sona erdi", vbCritical, "UYARI"
    Range("A2").Select: Exit Sub
End If
For i = 5 To sut
    col.Add i - 4, CStr(CDate(Cells(1, i).Value))
Next i

Set z = CreateObject("Scripting.Dictionary")
For j = 2 To sat1
    If WorksheetFunction.CountIf(Range("A2:A" & sat1), Cells(j, "A").Value) > 1 Then
        MsgBox Cells(i, "A").Value & "Sipariş nosundan  2 tane var.Teke düşürerek devam ediniz." _
        & vbLf & "İşlem iptal edildi", vbCritical, "UYARI"
        Set z = Nothing
        Exit Sub
    End If
    If Not z.exists(Cells(j, "A").Value) Then
        If Cells(j, "A").Value <> "" Then
            n = n + 1
            z.Add Cells(j, "A").Value, n
        End If
    End If
Next
ReDim myarr(1 To sut - 4, 1 To n)
Application.ScreenUpdating = False
For Each sh In Worksheets
    If UCase(Left(sh.Name, 2)) = "NO" Then
        If sh.AutoFilterMode = True Then sh.AutoFilterMode = False
        sat2 = sh.Cells(65536, "B").End(xlUp).Row
        myarr2 = sh.Range("A1:H" & sat2).Value
        For i = 2 To sat2
            If Not z.exists(myarr2(i, 2)) Then
                If sh.Cells(i, "B").Value <> "" Then
                    n = n + 1
                    z.Add myarr2(i, 2), n
                    ReDim Preserve myarr(1 To sut - 4, 1 To n)
                End If
            End If
            For j = 2 To sat1
                If IsNumeric(myarr2(i, 8)) And myarr2(i, 2) <> "" Then
                        myarr(CInt(col(CStr(myarr2(i, 1)))), z.Item(myarr2(i, 2))) _
                        = myarr(CInt(col(CStr(myarr2(i, 1)))), z.Item(myarr2(i, 2))) + sh.Cells(i, "H").Value
                End If
            Next j
        Next i
        Erase myarr2
    End If
Next sh
Range("E2").Resize(n, sut - 4) = Application.Transpose(myarr)
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı" & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[Orion1]

1-2 değişiklik yaparak dahada hızlandırdım.
Dosya 7nci mesajdadır.

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak formülle hazırladığım örnek dosyayı incelermisiniz.

AA sütununda dinamik ad tanımlaması uygulaması yapılmıştır. Formül içinde bu ad tanımlaması kullanılmıştır.

Formül kurgusu için Sn. Ali beye çok teşekkür ederim.


E2 hücresine uygulayınız.

=TOPLA.ÇARPIM(--(S(KAYDIR(DOLAYLI("'"&Sayfalar&"'!A2:A100");SATIR(DOLAYLI("2:100"))-2;0;1))=E$1);--(S(KAYDIR(DOLAYLI("'"&Sayfalar&"'!B2:B100");SATIR(DOLAYLI("2:100"))-2;0;1))=$A2);S(KAYDIR(DOLAYLI("'"&Sayfalar&"'!H2:H100");SATIR(DOLAYLI("2:100"))-2;0;1)))

 

[alper81]

yardımlarınız için teşekkürler bi sorum daha olacak bu çalışmayı program haline getirebilirmiyiz