Farklı dosyalardan veri alıp, şarta göre toplam alma...

[manly]

Benim istediğim;
KAYIT dosyasındaki verileri olduğu gibi ÇIKTI dosyasındaki AKTAR sayfasına aktarılıp,
B sütunundaki Ürün Koduna göre süzülüp D sütunundaki toplamlarını alıp ÇIKTI sayfasına aktarılmasını istiyorum. Yardımcı olursanız sevinirim...

 

[Emir Hüseyin Çoban]

. . .

Dosyanız ekte.
Tablolar aynı klasör içinde olmalı.

Düzeltme:
Çalışmanın sonra haline göre ek güncellenmiştir.
. . .

 

[manly]

Ellerinize sağlık çok teşekkür ederim...

 

[ertmer]

çok iyi bir çalışma benim işime yaradı teşekkürler

 

[manly]

Hocam bugün deneme fırsatım oldu. Bir sorun var. KAYIT dosyasından ÇIKTI dosyasındaki TOPLAM STOK sayfasına veri aktarma işi tamam. Sorun B sütunundaki aynı kod numaralarının D sütunları toplaanacak ve diğ er sayfaya (ÇIKTI) aktarılacak...Bu işlem sırasında TOPLAM STOK sayfası değişmeyecek

 

[Emir Hüseyin Çoban]

. . .

Toplam Al butonu için aşağıdaki kodları kullanın.

Private Sub CommandButton127_Click()
Application.ScreenUpdating = False
Dim ST As Worksheet, SC As Worksheet
Set ST = Sheets("TOPLAM STOK")
Set SC = Sheets("ÇIKTI")

SC.Range("A2:E65536").ClearContents
ST.Range("A2:E65536").Copy SC.Range("A2")

For i = 2 To SC.[B65536].End(3).Row
SC.Cells(i, "D") = _
WorksheetFunction.SumIf(SC.Range("B2:B65536"), SC.Cells(i, "B"), SC.Range("D2:D65536"))
Next i

For b = SC.[B65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(SC.Range("A1:F" & b), SC.Cells(b, "a")) > 1 Then SC.Rows(b).Delete
Next

Application.ScreenUpdating = True
MsgBox " B i t t i "
End Sub

. . .

 

[manly]

Hocam her şey güzel fakat toplamları yanlış alıyor...

 

[Emir Hüseyin Çoban]

. . .

#6 nolu mesajımdaki kodları revize ettim, deneyiniz.

. . .

 

[manly]

Hocam dosyaları tekrar güncelledim. Sizin revize ettiğiniz kodlar eklenmiş olarak... Fakat bir tuhaflık var. Her iki taraftaki toplamların genel toplamları eşit olmuyor...

 

[Emir Hüseyin Çoban]

. . .

Dosyanızda kodlar yok.
Ben kodların uygulanmış son halini ekliyorum.
Sanırım Çıktı sayfasında sütun silmişsiniz. (Stok / Malzeme Adı)

Tablo toplamlar
ÇIKTI: 1.924.500
TOPLAM STOK: 1.924.500
KAYIT: 1.924.500

Düzeltme:

If WorksheetFunction.CountIf(SC.Range("[COLOR="Red"]A1:F[/COLOR]" & b), SC.Cells(b, [COLOR="Red"]"a"[/COLOR])) > 1 Then SC.Rows(b).Delete

Kırmızı ile belirttiğim kısımlarda hata yapmışım, nasıl gözümden kaçmış bilmiyorum.
Düzeltmelerini yaptım. Ekteki dosyayı deneyiniz.

. . .

 

[Emir Hüseyin Çoban]

. . .

#10 nolu mesajımda Düzeltmelerini yaptım, tekrar deneyiniz.

. . .

 

[manly]

Ellerinize sağlık hocam....

 

[manly]

Hocam güncelleyip gönderdiğim ÇIKTI dosyasındaki menüde, Cam Kodu giriniz hanesine Cam kodunu girip TOPLAM STOK sayfasında sorgulattıktan sonra aynı olanları İSTENEN LİSTE sayfasına aktarsın istiyorum

 

[Emir Hüseyin Çoban]

. . .

Cam kodu, ürün kodu sanırım.
Ara butonu için kodlar.
Not: Bu soru konu başlığına uygun değil. Yeni bir başlık altında işlemek gerekir.

Private Sub CommandButton130_Click()
Application.ScreenUpdating = False
Dim ST As Worksheet
Dim SL As Worksheet
Set ST = Sheets("TOPLAM STOK")
Set SL = Sheets("İSTENEN LİSTE")
sat = 2
SL.Range("A2:F65536").ClearContents

If TextBox80.Value <> "" Then

STson = ST.[B65536].End(3).Row
For i = 2 To STson
If ST.Cells(i, "B") = TextBox80.Value Then
SL.Cells(sat, "A") = ST.Cells(i, "A")
SL.Cells(sat, "B") = ST.Cells(i, "B")
SL.Cells(sat, "C") = ST.Cells(i, "C")
SL.Cells(sat, "D") = ST.Cells(i, "D")
SL.Cells(sat, "E") = ST.Cells(i, "E")
SL.Cells(sat, "F") = ST.Cells(i, "F")
sat = sat + 1
Else
End If
Next i
Application.ScreenUpdating = True
sat = sat - 2
MsgBox " B i t t i " & Chr(10) & _
sat & " adet veri listelendi. "

Else
MsgBox " Veri Yok ", vbCritical
End If
TextBox80.Value = ""
End Sub

. . .

 

[manly]

Çok sağolun hocam....