Şartlara Göre Verilerin Aktarılması...

[manly]

Ekte gönderdiğim dosya açılıp menüdeki butona tıklanınca yapılması istenen bilgiler...

1. Z sütununda yıldızlar süzülüp W sütunundaki verilerin kendi aralarındaki toplamları SİPARİŞ DÖKÜMÜ sayfasındaki ilgili * olan yerlere aktarılacak..

2. Z sütununda tarihli olanlar süzülüp W sütunundaki verilerin kendi aralarındaki toplamları SİPARİŞ DÖKÜMÜ sayfasındaki ilgili TARİH yazan yerlere aktarılacak..

 

[İhsan Tank]

Ekte gönderdiğim dosya açılıp menüdeki butona tıklanınca yapılması istenen bilgiler...

1. Z sütununda yıldızlar süzülüp W sütunundaki verilerin kendi aralarındaki toplamları SİPARİŞ DÖKÜMÜ sayfasındaki ilgili * olan yerlere aktarılacak..

2. Z sütununda tarihli olanlar süzülüp W sütunundaki verilerin kendi aralarındaki toplamları SİPARİŞ DÖKÜMÜ sayfasındaki ilgili TARİH yazan yerlere aktarılacak..

Nasıl toplanacak bunu anlamadım

 

[manly]

Hocam öncelikle iyi akşamlar,

Z sütununu önce * olanları süzdük diyelim sonra W sütununda ONARIMDA olanlar kaç tane ise SİPARİŞ DÖKÜMÜ sayfasında ONARIMDA başlığının altındaki yıldız olan yere yazılacak...diğer verilerde aynı şekilde sayılıp ilgili yere eklenecek...

Tarihli olanlarda aynı şekilde olup TARİH olan yerlere aktarılacak..

NOT : Adet miktarları sayılmayacak, kaç satır veri çıkarsa satır sayısı toplanacak..

 

[İhsan Tank]

Hocam öncelikle iyi akşamlar,

Z sütununu önce * olanları süzdük diyelim sonra W sütununda ONARIMDA olanlar kaç tane ise SİPARİŞ DÖKÜMÜ sayfasında ONARIMDA başlığının altındaki yıldız olan yere yazılacak...diğer verilerde aynı şekilde sayılıp ilgili yere eklenecek...

Tarihli olanlarda aynı şekilde olup TARİH olan yerlere aktarılacak..

NOT : Adet miktarları sayılmayacak, kaç satır veri çıkarsa satır sayısı toplanacak..

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub sayım_61()
Dim ts, kaplan, trabzonspor, asi, hamsi As Date
Dim s1, s2
trabzonspor = MsgBox("Sayıma Başlıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
Set s1 = Sheets("2011 SİPARİŞLER")
Set s2 = Sheets("SİPARİŞ DÖKÜMÜ")
s2.Range("A3:X3").ClearContents
For asi = 1 To 21
kaplan = 0
If s2.Cells(2, asi) = "*" Then
For ts = 2 To s1.Cells(Rows.Count, "B").End(xlUp).Row
If s1.Cells(ts, "W") = s2.Cells(1, asi) And _
s1.Cells(ts, "Z") = s2.Cells(2, asi) Then
kaplan = kaplan + 1
s2.Cells(3, asi) = kaplan
End If
Next
ElseIf s2.Cells(2, asi) = "TARİH" Then
For ts = 2 To s1.Cells(Rows.Count, "B").End(xlUp).Row
If s1.Cells(ts, "W") = s2.Cells(1, asi - 1) And _
s1.Cells(ts, "Z") <> s2.Cells(2, asi - 1) Then
kaplan = kaplan + 1
s2.Cells(3, asi) = kaplan
End If
Next
ElseIf s2.Cells(2, asi) = "TOPLAM" Then
s2.Cells(3, asi) = s2.Cells(3, asi - 2) + s2.Cells(3, asi - 1)
End If
Next
s2.Range("V3") = s2.Range("A3") + s2.Range("D3") + s2.Range("G3") + _
s2.Range("J3") + s2.Range("M3") + s2.Range("P3") + s2.Range("S3")
s2.Range("W3") = s2.Range("B3") + s2.Range("E3") + s2.Range("H3") + _
s2.Range("K3") + s2.Range("N3") + s2.Range("Q3") + s2.Range("T3")
s2.Range("X3") = s2.Range("C3") + s2.Range("F3") + s2.Range("I3") + _
s2.Range("L3") + s2.Range("O3") + s2.Range("R3") + s2.Range("U3")
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Sayımı Bitirdim", , "Bitiş"
End Sub

 

[manly]

Range("V3") = Range("A3") + Range("D3") + Range("G3") + Range("J3") + _
Range("M3") + Range("P3") + Range("S3")

Bu satırlarda sarı renk oldu...

 

[İhsan Tank]

Range("V3") = Range("A3") + Range("D3") + Range("G3") + Range("J3") + _
Range("M3") + Range("P3") + Range("S3")

Bu satırlarda sarı renk oldu...

Üstteki kod'u güncelledim.

 

[manly]

Hocam çok teşekkürler.. yine hızır gibi yetiştiniz çok sağolun...

 

[İhsan Tank]

Hocam çok teşekkürler.. yine hızır gibi yetiştiniz çok sağolun...

Rica ederim
:keyif:

 

[manly]

İhsan hocam SİPARİŞ DÖKÜMÜ sayfası için yaptığımız bu makronun BİRLİK VE STOK açılımlarını ilgili sayfalara dökebilir miyiz...

Dosya EK'tedir.