• DİKKAT

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

Sütundaki veriler teke düşürülüp belli şartlara göre ilgili sayfaya 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 Numarası Listesi ve FirmaListesi butonlarına tıklanınca yapılması gereken işler...

Stok Numarası Listesi Butonuna tıklanınca,

1. 2011 siparişler sayfasındaki Stok numaraları teke düşürülecek,
2. Daha sonra W sütunundaki verilere göre * ise G sütunundaki adetler kendi aralarında toplanarak Stok Dökü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 toplanıp Stok Dökü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...


Firma Listesi Butonuna tıklanınca da yukarıdaki yollar izlenecek...



NOT : W sütununda HEK-İADE verisi var bu özel bir ayar istiyor.. bunun adetlerini ayırmak gerekiyor buda şöyle olması gerekiyor.. P sütunundaki hek adetleri toplanıp HEK başlığına S sütunundaki iade adetleri toplanıp İADE EDİLDİ hanesine eklenmesi gerekiyor..
 

Ekli dosyalar

Son düzenleme:
Merhaba
Stok İçin
Boş bir module
Kod: 
Option Explicit
Sub stok_no_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Ü")
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, "D")
kaplan = kaplan + 1
End If
Next
For mavi = 4 To s2.Cells(65536, "A").End(xlUp).Row
kaplan = 0
For bordo = 3 To 26
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 + s1.Cells(ts, "G")
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 + s1.Cells(ts, "G")
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 mavi = 4 To s2.Cells(65536, "A").End(xlUp).Row
s2.Cells(mavi, "AA") = 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, "X")
s2.Cells(mavi, "AB") = 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, "Y")
s2.Cells(mavi, "AC") = 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") _
+ s2.Cells(mavi, "Z")
Next
For bordo = 3 To 29
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
Kopyalayın ve deneyin.
 
Merhaba
Firma için
Boş bir module
Kod: 
Option Explicit
Sub stok_no_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Ü")
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, "D")
kaplan = kaplan + 1
End If
Next
For mavi = 4 To s2.Cells(65536, "A").End(xlUp).Row
kaplan = 0
For bordo = 3 To 26
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 + s1.Cells(ts, "G")
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 + s1.Cells(ts, "G")
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 mavi = 4 To s2.Cells(65536, "A").End(xlUp).Row
s2.Cells(mavi, "AA") = 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, "X")
s2.Cells(mavi, "AB") = 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, "Y")
s2.Cells(mavi, "AC") = 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") _
+ s2.Cells(mavi, "Z")
Next
For bordo = 3 To 29
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
Kopyalayın ve deneyin.
 
Hocam firma modülü stok no ile aynı gibi...
 
Hocam ayrıca böyle bir durum söz konusu...

W sütununda HEK-İADE verisi var bu özel bir ayar istiyor.. bunun adetlerini ayırmak gerekiyor buda şöyle olması gerekiyor.. P sütunundaki hek adetleri toplanıp HEK başlığına S sütunundaki iade adetleri toplanıp İADE EDİLDİ hanesine eklenmesi gerekiyor..
 
manly' Alıntı:
Hocam firma modülü stok no ile aynı gibi...
Genişletmek için tıkla ...

Farkeder mi_? Aynı kodla çözüm işi

manly' Alıntı:
Hocam ayrıca böyle bir durum söz konusu...

W sütununda HEK-İADE verisi var bu özel bir ayar istiyor.. bunun adetlerini ayırmak gerekiyor buda şöyle olması gerekiyor.. P sütunundaki hek adetleri toplanıp HEK başlığına S sütunundaki iade adetleri toplanıp İADE EDİLDİ hanesine eklenmesi gerekiyor..
Genişletmek için tıkla ...

Bunu baştan söylemeniz lazımdı kodu şimdi baştan dizayn etmek gerekiyor. Sence bunu yapmalımıyım. Siz söyleyin şimdi ben saatlerce uğraştım sorunuza uygun kodu yapabilmek için şimdi diyorsunuz ki sen biraz daha uğraş.
 
Özür dilerim...haklısınız...ben sayfamı güncellemiştim sanırım geç kalmışım....Yine de her şey için çok teşekkür ederim... hakkınızı helal edin...
 
İhsan hocam, rica etsem şu HEK-İADE olayına da bir el atsanız...Eski kodları bozmadan buna farklı bir kod yazabilirmiyiz...
 

Ekli dosyalar

Çok teşekkür ederim...Allah razı olsun....

W sütununda HEK-İADE olanların miktarları P sütununda HEK, miktarı S sütununda İADE miktarı yazıyor.. Diğerlerinin adetleri G sütununda bulunmaktadır. W sütunundaki Sipariş durumlarında sadece sorun HEK-İADE verilerinde. Diğerlerinin miktarını G sütunundan alırken, HEK-İADE miktarını P ve S sütunundan toplayarak ilgili yere aktaracak.
 
manly' Alıntı:
Çok teşekkür ederim...Allah razı olsun....

W sütununda HEK-İADE olanların miktarları P sütununda HEK, miktarı S sütununda İADE miktarı yazıyor.. Diğerlerinin adetleri G sütununda bulunmaktadır. W sütunundaki Sipariş durumlarında sadece sorun HEK-İADE verilerinde. Diğerlerinin miktarını G sütunundan alırken, HEK-İADE miktarını P ve S sütunundan toplayarak ilgili yere aktaracak.
Genişletmek için tıkla ...

HEK-İADE sütunlarındaki toplamlar P ve S sütunlarına göre mi hesaplanacak_?
Açıklamalarınızı netleştirin.
 
Evet hocam HEK-İADE sütunlarındaki toplamlar P ve S sütunlarına göre hesaplanacak...P sütunu Hekleri S sütunu İade edildilerin adetleri
 
manly' Alıntı:
Evet hocam HEK-İADE sütunlarındaki toplamlar P ve S sütunlarına göre hesaplanacak...P sütunu Hekleri S sütunu İade edildilerin adetleri
Genişletmek için tıkla ...

Yalnız açıklamalarınız hala eksik. Hek-İade lerde çıkan sonuçları Hek'in üstüne mi toplanacak yoksa Hek-İade sütunlarına mı toplanacak.
 
Çalışma Durumundaki Hek-İade ler belirlendikten sonra aynı satırda P sütunundakiler HEK başlığına S sütunundaki değerlerde İADE EDİLDİ başlığına eklenecek..HEK-İADE satırındaki ADET sütunundakiler dikkate alınmayacak..
 
Silebilirsiniz hocam gerek kalmayacak...
 
manly' Alıntı:
Silebilirsiniz hocam gerek kalmayacak...
Genişletmek için tıkla ...

Merhaba
Stok için
Kod: 
Option Explicit
Sub stok_no_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Ü")
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
kaplan = 0
For bordo = 3 To 23
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 + s1.Cells(ts, "G")
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 + s1.Cells(ts, "G")
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
 
manly' Alıntı:
Silebilirsiniz hocam gerek kalmayacak...
Genişletmek için tıkla ...

Merhaba
Firma için
Kod: 
Option Explicit
Sub firma_61()
Dim ts, kaplan, trabzonspor, bordo, mavi, süre As Date
Dim s1, s2
Set s1 = Sheets("2011 SİPARİŞLER")
Set s2 = Sheets("FİRMA DÖKÜMÜ")
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
kaplan = 0
For bordo = 3 To 23
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 + s1.Cells(ts, "G")
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 + s1.Cells(ts, "G")
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
 
Hocam inanın hakkınız ödenmez...Çok teşekkür ederim...Allah razı olsun...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst