Sütundaki veriler teke düşürülüp belli şartlara göre ilgili sayfaya aktarılması

İhsan Tank · 2 Ekim 2011

manly' Alıntı:
Hocam inanın hakkınız ödenmez...Çok teşekkür ederim...Allah razı olsun...

Hakkımı ödediniz rahat olun
Rica ederim
Allah sizdende razı olsun
:keyif:

manly · 2 Ekim 2011

Hocam şu hesaplamalar için bugün bir küçük deneme yaptım ve sorunlarla karşılaştım. HEK_İADE olayından vazgeçtim, değerler çok karışık çıkıyor.. Gönderdiğim dosyada TARİH yazan hanelere nedense veriler iki katı geliyor..Bu sorunu düzelttik mi yeterli olacak..

NOT :
Hem STOK DÖKÜMÜ hem de FİRMA DÖKÜMÜ verilerin eşit olması gerekiyor...Sonuçta adet toplamları değişmemesi gerekiyor.

manly · 3 Ekim 2011

İhsan hocam yardımlarınızı bekliyorum...

İhsan Tank · 4 Ekim 2011

manly' Alıntı:
İhsan hocam yardımlarınızı bekliyorum...

İhsan hoca yorgun kendi işi ile ilgileniyor fırsattan istifade biraz dinleneyim dedim senin yardım mesajını görünce dayanamadım.
Stok Kodu 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
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 + 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

Firma kodu 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
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 + 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

Bu kodu kullanınız

manly · 4 Ekim 2011

Allah razı olsun hocam..Çok teşekkür ederim..Sabah 6 da işe giderken kodları aldım, iş yerinde deneyeceğim...

İhsan Tank · 4 Ekim 2011

manly' Alıntı:
Allah razı olsun hocam..Çok teşekkür ederim..Sabah 6 da işe giderken kodları aldım, iş yerinde deneyeceğim...

Allah sizdende razı olsun
Rica ederim
:keyif:

manly · 4 Ekim 2011

Hocam bugün yaptığım denemelerde olumlu sonuç aldım... Sadece HEK-İADE olayı çok karışık bilgiler verince bunu devreden çıkarmaya karar verdim.

HEK-İADE hesaplamasını yapan bölümü devreden çıkararak bunu hallettim...Her şey için çok teşekkür ederim...

İhsan Tank · 4 Ekim 2011

manly' Alıntı:
Hocam bugün yaptığım denemelerde olumlu sonuç aldım... Sadece HEK-İADE olayı çok karışık bilgiler verince bunu devreden çıkarmaya karar verdim.

HEK-İADE hesaplamasını yapan bölümü devreden çıkararak bunu hallettim...Her şey için çok teşekkür ederim...

Rica ederim
:keyif:

manly · 7 Ekim 2011

Hocam yine rahatsız ediyorum ama bir sorunla karşılaştım.. STOK DÖKÜMÜ ve BİRLİK DÖKÜMÜ sayfalarının üst toplamları eşit olması gerekirken BİRLİK DÖKÜMÜ sayfasındaki veriler hatalı sonuç veriyor kodlarda bir değişiklik mi oldu acaba? yardım ederseniz sevinirim...

Not : 24 . mesajınızdaki HEK-İADE olayını iptal etmiştik..Bende kodları ona göre ayarlamıştım ama sorun var sanırım..O mesajdaki kodları denedim. Çalışma durumundaki HEK-İADE olanları kaldırıp hesaplatınca veriler eşit oldu... Sanırım o kodları kaldırmadan devam edeceğim...

manly · 9 Ekim 2011

Hocam 24. mesajınızda aldığımız dökümleri G sütunundaki adet toplamlarına göre yapmıştık... Şimdi sizden istediğim...Satır sayılarına göre dökümünü almak ... bu mümkün mü? acaba...

manly · 10 Ekim 2011

İhsan hocam acil yardımlarınızı bekliyorum....

İhsan Tank · 10 Ekim 2011

manly' Alıntı:
İhsan hocam acil yardımlarınızı bekliyorum....

Sorunuzun cevabını yeni bir başlıkta açık olarak anlatınız bu konudan sıkıldım ( biraz canım sıkkın şu an )

manly · 10 Ekim 2011

Peki hocam kolay gelsin...

Sütundaki veriler teke düşürülüp belli şartlara göre ilgili sayfaya aktarılması

İhsan Tank

Misafir

manly

Ekli dosyalar

manly

İhsan Tank

Misafir

manly

İhsan Tank

Misafir

manly

İhsan Tank

Misafir

manly

Ekli dosyalar

manly

Ekli dosyalar

manly

İhsan Tank

Misafir

manly