• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Mükerrer kayıtlar teke düşürülerek, şartlara göre aktarılması...

  • Konbuyu başlatan Konbuyu başlatan manly
  • Başlangıç tarihi Başlangıç tarihi
M

manly

Katılım
25 Nisan 2005
Mesajlar
690
Excel Vers. ve Dili
Excel 2003 Türkçe
Ekte gönderdiğim dosya açıldığında Stok Bazında Listele ve Birlik Bazında Listele butonlarına tıklanınca yapılması gereken işler...

1. 2011 siparişler sayfasındaki Stok numaraları teke düşürülecek,

2. Daha sonra W sütunundaki Sipariş Durumlarına göre Z sütunundaki * olanlar sayılıp Stok Dökümü Açılımı sayfasındaki ilgili yerlere aktarılacak..

mesela,
1055-27-011-0912 stok numaralı malzeme teke düşürülürken Z sütununda * olup W sütununda Onarımda olanlar sayılıp Stok Dökümü Açılımı sayfasındaki Onarımda başlığının yıldız olan yere yani C sütununa eklenecek. Diğerleri de aynı yolu takip edecek. Z sütununda tarihli olanlarda aynı yoldan ilgili yerlerine aktarılacak.

3. Stok dökümü sayfasındaki renkli yerlere yan toplam ve alt toplamlar alınacak...


Birlik Bazında Listele Butonuna tıklanınca da yukarıdaki yollar izlenecek...
 

Ekli dosyalar

Sanırım Hallettim...

Stok İçin...


Option Explicit
Sub stok_say_61()
Dim ts, kaplan, trabzonspor, bordo, mavi, süre As Date
Dim s1, s2
Set s1 = Sheets("2011 SİPARİŞLER")
Set s2 = Sheets("STOK DÖKÜMÜ AÇILIMI")
trabzonspor = MsgBox("Sayıma Başlıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
süre = Time
s2.Range("C3:AC3,A4:AC30").ClearContents
kaplan = 4
For ts = 2 To s1.Cells(65536, "B").End(xlUp).Row
If WorksheetFunction.CountIf(s1.Range("C2:C" & ts), s1.Cells(ts, "C")) = 1 Then
s2.Cells(kaplan, "A") = s1.Cells(ts, "C")
s2.Cells(kaplan, "B") = s1.Cells(ts, "F")
kaplan = kaplan + 1
End If
Next
For mavi = 4 To s2.Cells(65536, "A").End(xlUp).Row
For bordo = 3 To 23
kaplan = 0
If s2.Cells(2, bordo) = "*" Then
For ts = 2 To s1.Cells(65536, "B").End(xlUp).Row
If s1.Cells(ts, "C") = s2.Cells(mavi, "A") And _
s1.Cells(ts, "W") = s2.Cells(1, bordo) And _
s1.Cells(ts, "Z") = s2.Cells(2, bordo) Then
kaplan = kaplan + 1
s2.Cells(mavi, bordo) = kaplan
End If
Next
ElseIf s2.Cells(2, bordo) = "TARİH" Then
For ts = 2 To s1.Cells(65536, "B").End(xlUp).Row
If s1.Cells(ts, "C") = s2.Cells(mavi, "A") And _
s1.Cells(ts, "W") = s2.Cells(1, bordo - 1) And _
s1.Cells(ts, "Z") <> s2.Cells(2, bordo - 1) Then
kaplan = kaplan + 1
s2.Cells(mavi, bordo) = kaplan
End If
Next
ElseIf s2.Cells(2, bordo) = "TOPLAM" Then
s2.Cells(mavi, bordo) = s2.Cells(mavi, bordo - 2) + s2.Cells(mavi, bordo - 1)
End If
Next
Next
For ts = 2 To s1.Cells(65536, "B").End(xlUp).Row
If s1.Cells(ts, "W") = "HEK-İADE" And s1.Cells(ts, "Z") = "*" Then
For mavi = 4 To s2.Cells(65536, "A").End(xlUp).Row
s2.Cells(mavi, "O") = s2.Cells(mavi, "O") + s1.Cells(ts, "P")
s2.Cells(mavi, "U") = s2.Cells(mavi, "U") + s1.Cells(ts, "S")
Next
ElseIf s1.Cells(ts, "W") = "HEK-İADE" And s1.Cells(ts, "Z") <> "*" Then
For mavi = 4 To s2.Cells(65536, "A").End(xlUp).Row
s2.Cells(mavi, "P") = s2.Cells(mavi, "P") + s1.Cells(ts, "P")
s2.Cells(mavi, "V") = s2.Cells(mavi, "V") + s1.Cells(ts, "S")
Next
End If
Next
For mavi = 4 To s2.Cells(65536, "A").End(xlUp).Row
s2.Cells(mavi, "X") = s2.Cells(mavi, "C") + s2.Cells(mavi, "F") + s2.Cells(mavi, "I") _
+ s2.Cells(mavi, "L") + s2.Cells(mavi, "O") + s2.Cells(mavi, "R") + s2.Cells(mavi, "U")
s2.Cells(mavi, "Y") = s2.Cells(mavi, "D") + s2.Cells(mavi, "G") + s2.Cells(mavi, "J") _
+ s2.Cells(mavi, "M") + s2.Cells(mavi, "P") + s2.Cells(mavi, "S") + s2.Cells(mavi, "V")
s2.Cells(mavi, "Z") = s2.Cells(mavi, "E") + s2.Cells(mavi, "H") + s2.Cells(mavi, "K") _
+ s2.Cells(mavi, "N") + s2.Cells(mavi, "Q") + s2.Cells(mavi, "T") + s2.Cells(mavi, "W")
Next
For bordo = 3 To 26
s2.Cells(3, bordo) = WorksheetFunction.Sum(s2.Columns(bordo))
Next
Application.ScreenUpdating = True
MsgBox Format(süre - Time, "hh:mm:ss") & " Sürede Sayım Bitti", vbInformation, "Bitiş"
End Sub


Birlik Dökümü İçin....



Option Explicit
Sub birlik_say_61()
Dim ts, kaplan, trabzonspor, bordo, mavi, süre As Date
Dim s1, s2
Set s1 = Sheets("2011 SİPARİŞLER")
Set s2 = Sheets("BİRLİK DÖKÜMÜ AÇILIMI")
trabzonspor = MsgBox("Sayıma Başlıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
süre = Time
s2.Range("C3:AC3,A4:AC30").ClearContents
kaplan = 4
For ts = 2 To s1.Cells(65536, "B").End(xlUp).Row
If WorksheetFunction.CountIf(s1.Range("D2:D" & ts), s1.Cells(ts, "D")) = 1 Then
s2.Cells(kaplan, "A") = s1.Cells(ts, "D")
kaplan = kaplan + 1
End If
Next
For mavi = 4 To s2.Cells(65536, "A").End(xlUp).Row
For bordo = 3 To 23
kaplan = 0
If s2.Cells(2, bordo) = "*" Then
For ts = 2 To s1.Cells(65536, "B").End(xlUp).Row
If s1.Cells(ts, "D") = s2.Cells(mavi, "A") And _
s1.Cells(ts, "W") = s2.Cells(1, bordo) And _
s1.Cells(ts, "Z") = s2.Cells(2, bordo) Then
kaplan = kaplan + 1
s2.Cells(mavi, bordo) = kaplan
End If
Next
ElseIf s2.Cells(2, bordo) = "TARİH" Then
For ts = 2 To s1.Cells(65536, "B").End(xlUp).Row
If s1.Cells(ts, "D") = s2.Cells(mavi, "A") And _
s1.Cells(ts, "W") = s2.Cells(1, bordo - 1) And _
s1.Cells(ts, "Z") <> s2.Cells(2, bordo - 1) Then
kaplan = kaplan + 1
s2.Cells(mavi, bordo) = kaplan
End If
Next
ElseIf s2.Cells(2, bordo) = "TOPLAM" Then
s2.Cells(mavi, bordo) = s2.Cells(mavi, bordo - 2) + s2.Cells(mavi, bordo - 1)
End If
Next
Next
For ts = 2 To s1.Cells(65536, "B").End(xlUp).Row
If s1.Cells(ts, "W") = "HEK-İADE" And s1.Cells(ts, "Z") = "*" Then
For mavi = 4 To s2.Cells(65536, "A").End(xlUp).Row
s2.Cells(mavi, "O") = s2.Cells(mavi, "O") + s1.Cells(ts, "P")
s2.Cells(mavi, "U") = s2.Cells(mavi, "U") + s1.Cells(ts, "S")
Next
ElseIf s1.Cells(ts, "W") = "HEK-İADE" And s1.Cells(ts, "Z") <> "*" Then
For mavi = 4 To s2.Cells(65536, "A").End(xlUp).Row
s2.Cells(mavi, "P") = s2.Cells(mavi, "P") + s1.Cells(ts, "P")
s2.Cells(mavi, "V") = s2.Cells(mavi, "V") + s1.Cells(ts, "S")
Next
End If
Next
For mavi = 4 To s2.Cells(65536, "A").End(xlUp).Row
s2.Cells(mavi, "X") = s2.Cells(mavi, "C") + s2.Cells(mavi, "F") + s2.Cells(mavi, "I") _
+ s2.Cells(mavi, "L") + s2.Cells(mavi, "O") + s2.Cells(mavi, "R") + s2.Cells(mavi, "U")
s2.Cells(mavi, "Y") = s2.Cells(mavi, "D") + s2.Cells(mavi, "G") + s2.Cells(mavi, "J") _
+ s2.Cells(mavi, "M") + s2.Cells(mavi, "P") + s2.Cells(mavi, "S") + s2.Cells(mavi, "V")
s2.Cells(mavi, "Z") = s2.Cells(mavi, "E") + s2.Cells(mavi, "H") + s2.Cells(mavi, "K") _
+ s2.Cells(mavi, "N") + s2.Cells(mavi, "Q") + s2.Cells(mavi, "T") + s2.Cells(mavi, "W")
Next
For bordo = 3 To 26
s2.Cells(3, bordo) = WorksheetFunction.Sum(s2.Columns(bordo))
Next

Application.ScreenUpdating = True
MsgBox Format(süre - Time, "hh:mm:ss") & " Sürede Sayım Bitti", vbInformation, "Bitiş"
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst