• DİKKAT

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

Ekli dosyaya makro yazamadım.

A

abbasonline

Katılım
8 Mart 2009
Mesajlar
504
Excel Vers. ve Dili
2010
Makro ile sayfalar arası toplama ve çıkarma.

ayrıca sonuç sayfasının NOSUNA yazdığım ürün GİREN sayfasında yoksa uyarı verebilirmi.
 

Ekli dosyalar

Son düzenleme:
abbasonline' Alıntı:
Makro ile sayfalar arası toplama ve çıkarma.

ayrıca sonuç sayfasının NOSUNA yazdığım ürün GİREN sayfasında yoksa uyarı verebilirmi.
Genişletmek için tıkla ...

Merhaba
Sonuç sayfasının kod bölümüne
Kod: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ts
Set ts = Sheets("GİREN")
On Error GoTo Son
If Intersect(Target, Range("B4:B" & Rows.Count)) Is Nothing Then Exit Sub
If Target <> "" Then
If WorksheetFunction.CountIf(ts.Range("B4:B" & Rows.Count), Target) < 1 Then
MsgBox "Bu kayıt daha önce girilmiştir !", vbCritical, "Hata"
Target.ClearContents
Target.Select
Exit Sub
End If
End If
Son:
End Sub
Bu kodu
Boş bir module
Kod: 
Option Explicit
Sub toplayalım()
Dim ts, trabzonspor, hamsi As Date
Dim s1, s2, s3
Set s1 = Sheets("GİREN")
Set s2 = Sheets("ÇIKAN")
Set s3 = Sheets("SONUÇ")
For ts = 4 To s3.Cells(Rows.Count, "B").End(xlUp).Row
s3.Cells(ts, "C") = WorksheetFunction.VLookup(s3.Cells(ts, "B"), _
s1.Range("B:D"), 2, 0)
s3.Cells(ts, "H") = WorksheetFunction.VLookup(s3.Cells(ts, "B"), _
s1.Range("B:D"), 2, 0)
s3.Cells(ts, "N") = s3.Cells(ts, "C")
s3.Cells(ts, "D") = WorksheetFunction.VLookup(s3.Cells(ts, "B"), _
s1.Range("B:D"), 3, 0)
s3.Cells(ts, "I") = WorksheetFunction.VLookup(s3.Cells(ts, "B"), _
s1.Range("B:D"), 3, 0)
s3.Cells(ts, "O") = s3.Cells(ts, "D")
s3.Cells(ts, "E") = WorksheetFunction.SumIf(s1.Range("B:B"), s3. _
Cells(ts, "B"), s1.Range("E:E"))
s3.Cells(ts, "J") = WorksheetFunction.SumIf(s2.Range("B:B"), s3. _
Cells(ts, "B"), s2.Range("E:E"))
s3.Cells(ts, "P") = s3.Cells(ts, "E") - s3.Cells(ts, "J")
s3.Cells(ts, "F") = WorksheetFunction.SumIf(s1.Range("B:B"), s3. _
Cells(ts, "B"), s1.Range("F:F"))
s3.Cells(ts, "K") = WorksheetFunction.SumIf(s2.Range("B:B"), s3. _
Cells(ts, "B"), s2.Range("F:F"))
s3.Cells(ts, "Q") = s3.Cells(ts, "F") - s3.Cells(ts, "K")
Next
End Sub
Bu kodu kopyalayın ve deneyin.
 
İhsan bey, SONUÇ sayfasında kalan kısmında ürünleri topluyor, çıkarma işlemi yapmıyor.


düzelttim herhalde makrodaki (+) işaretini (-) yapınca çıkarma işlemini yaptı teşekkürler, kolay gelsin.
 
Son düzenleme:
abbasonline' Alıntı:
İhsan bey, SONUÇ sayfasında kalan kısmında ürünleri topluyor, çıkarma işlemi yapmıyor.


düzelttim herhalde makrodaki (+) işaretini (-) yapınca çıkarma işlemini yaptı teşekkürler, kolay gelsin.
Genişletmek için tıkla ...

Hep topla topla bende onu toplamışım :)
Üstteki kodu güncelledim
Rica ederim
:keyif:
 
İhsan bey, kusara bakmassanız ben sizin yaptığınız makroları dosyama uyarlayamadım, ancak göndermiş olduğum dosyaya uyarladım normal çılışıyor, kendi orjinal dosyada sütunların yerleri farklı olduğu için uyarlayamadım yardımcı olurmusunuz, tekrar kusura bakmayın.
 

Ekli dosyalar

Son düzenleme:
abbasonline' Alıntı:
İhsan bey, kusara bakmassanız ben sizin yaptığınız makroları dosyama uyarlayamadım, ancak göndermiş olduğum dosyaya uyarladım normal çılışıyor, kendi orjinal dosyada sütunların yerleri farklı olduğu için uyarlayamadım yardımcı olurmusunuz, tekrar kusura bakmayın.
Genişletmek için tıkla ...

Sabır biraz benim de çalıştığım bir iş yeri var ve bazen aşırı yoğun oluyor fırsat bulamıyorum
kodları bunlarla değiştirin.
Sayfadakini
Kod: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ts
Set ts = Sheets("GİREN")
On Error GoTo Son
If Intersect(Target, Range("B4:B" & Rows.Count)) Is Nothing Then Exit Sub
If Target <> "" Then
If WorksheetFunction.CountIf(ts.Range("G4:G" & Rows.Count), Target) < 1 Then
MsgBox "Bu kayıt daha önce girilmiştir !", vbCritical, "Hata"
Target.ClearContents
Target.Select
Exit Sub
End If
End If
Son:
End Sub
Module'dekini
Kod: 
Option Explicit
Sub toplayalım()
Dim ts, trabzonspor, hamsi As Date
Dim s1, s2, s3
Set s1 = Sheets("GİREN")
Set s2 = Sheets("ÇIKAN")
Set s3 = Sheets("SONUÇ")
trabzonspor = MsgBox("Sonuçları Topluyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
For ts = 3 To s3.Cells(Rows.Count, "B").End(xlUp).Row
s3.Cells(ts, "C") = WorksheetFunction.VLookup(s3.Cells(ts, "B"), _
s1.Range("G:I"), 2, 0)
s3.Cells(ts, "D") = WorksheetFunction.VLookup(s3.Cells(ts, "B"), _
s1.Range("G:I"), 3, 0)
s3.Cells(ts, "I") = WorksheetFunction.VLookup(s3.Cells(ts, "B"), _
s1.Range("G:I"), 3, 0)
s3.Cells(ts, "O") = s3.Cells(ts, "D")
s3.Cells(ts, "E") = WorksheetFunction.SumIf(s1.Range("G:G"), s3.Cells _
(ts, "B"), s1.Range("J:J"))
s3.Cells(ts, "J") = WorksheetFunction.SumIf(s2.Range("G:G"), s3.Cells _
(ts, "B"), s2.Range("J:J"))
s3.Cells(ts, "P") = s3.Cells(ts, "E") - s3.Cells(ts, "J")
s3.Cells(ts, "F") = WorksheetFunction.SumIf(s1.Range("G:G"), s3.Cells _
(ts, "B"), s1.Range("K:K"))
s3.Cells(ts, "K") = WorksheetFunction.SumIf(s2.Range("G:G"), s3.Cells _
(ts, "B"), s2.Range("K:K"))
s3.Cells(ts, "Q") = s3.Cells(ts, "F") - s3.Cells(ts, "K")
s3.Cells(ts, "G") = WorksheetFunction.SumIf(s1.Range("G:G"), s3.Cells _
(ts, "B"), s1.Range("L:L"))
s3.Cells(ts, "L") = WorksheetFunction.SumIf(s2.Range("G:G"), s3.Cells _
(ts, "B"), s2.Range("L:L"))
s3.Cells(ts, "R") = s3.Cells(ts, "G") - s3.Cells(ts, "L")
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Toplamları Çıkardım", , "Bitiş"
End Sub
 
Option Explicit
Sub toplayalım()
Dim ts, trabzonspor, hamsi As Date
Dim s1, s2, s3
Set s1 = Sheets("GİRİŞ")
Set s2 = Sheets("ÇIKIŞ")
Set s3 = Sheets("SONUÇ")
trabzonspor = MsgBox("Sonuçları Topluyorum, ...........", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
For ts = 3 To s3.Cells(Rows.Count, "B").End(xlUp).Row
s3.Cells(ts, "C") = WorksheetFunction.VLookup(s3.Cells(ts, "B"), _
s1.Range("G:I"), 2, 0)
s3.Cells(ts, "D") = WorksheetFunction.VLookup(s3.Cells(ts, "B"), _
s1.Range("G:I"), 3, 0)
s3.Cells(ts, "I") = WorksheetFunction.VLookup(s3.Cells(ts, "B"), _
s1.Range("G:I"), 3, 0)
s3.Cells(ts, "O") = s3.Cells(ts, "D")
s3.Cells(ts, "E") = WorksheetFunction.SumIf(s1.Range("G:G"), s3.Cells _
(ts, "B"), s1.Range("J:J"))
s3.Cells(ts, "J") = WorksheetFunction.SumIf(s2.Range("G:G"), s3.Cells _
(ts, "B"), s2.Range("J:J"))
s3.Cells(ts, "P") = s3.Cells(ts, "E") - s3.Cells(ts, "J")
s3.Cells(ts, "F") = WorksheetFunction.SumIf(s1.Range("G:G"), s3.Cells _
(ts, "B"), s1.Range("K:K"))
s3.Cells(ts, "G") = WorksheetFunction.SumIf(s1.Range("G:G"), s3.Cells _
(ts, "B"), s1.Range("L:L"))
s3.Cells(ts, "L") = WorksheetFunction.SumIf(s2.Range("G:G"), s3.Cells _
(ts, "B"), s2.Range("L:L"))
s3.Cells(ts, "R") = s3.Cells(ts, "G") - s3.Cells(ts, "L")
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& ".............., Sürede Toplamları Çıkardım", Application.ScreenUpdating = True
MsgBox "İşlem Tamamlanmıştır, ................", vbOKOnly + vbInformation, "..............."
End Sub





İhsan bey yukarıdaki makro yu siz yazmıştınız ve düzgün çalışıyor teşekkürler, ancak birde "DEVİR" sayfası eklendi bunuda yukarıdaki makroya nasıl dahil edebilirim, tüm özellikleri aynı sadece "DEVİR" ile "GİRİŞ" i toplayıp "ÇIKIŞ" dan çıkaracak ve "SONUÇ" sayfasına yazacak (Not: DEVİR sayfasındaki verilerde GİRİŞ sayfasındaki ile aynı.
 
Son düzenleme:
Neden ayrıldıki, forum üyelerine çok fazla katkıda bulunup yardımcı oluyordu.
 
Dosyaya yardım edebilirmiyiz, yazılı makroya ekleme yapmam için.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst