Sayfalarda kontrol et say

[ADER_34]

Selam hayırlı akşamlar arkadaşlar bi konuda daha takıldım şöyle bir sorunum var,
3 sayfada veri kontrolü yapıp 1 sütunda saymam gereken veriler var işin içinden çıkamadım yardımcı olurmusunuz? sorum şu "sayfa1" "E" Sütunu ve "B" sütununa sürekli veri girişi yapıyorum, girilen değerler sayfa2 de önceden belirlenmiş veriler,ve sayfa 3 de ise sadece "sayfa1 "B" sütunundaki değerler var. Amacım
sayfa1 "B" ve "E" sütunundaki satırları sürekli kontrol et,sayfa2 "A" VE "B" sütunlarında bu veriler sayfa 1 de eşit şekilde girilmişse sonucu sayfa3 "E" sütununa sayarak yaz.örnek dosyam ekte kolay gelsin teşekkürler..
http://s8.dosya.tc/server2/v243px/3_sayfada_dogrula.rar.html

 

[Mustafa MUTLU]

Kardeşim 2003 xls formatında eklerseniz bakabilirim.

 

[ADER_34]

Mustafa Bey ,bunu nasıl yababilirim ,OFFİCE 2010 kullanıyorum?

 

[Mustafa MUTLU]

Dosyayı farklı kaydet deyin
Açılan kutunun en altında Dosya türleri var oradan
2003 xls yada sadece xls yi seçin
Kaydedin..

 

[ADER_34]

http://s8.dosya.tc/server2/l9etb6/3_sayfada_dogrula2.rar.html
Dediğiniz gibi yaptım oldu Mustafa bey

 

[Mustafa MUTLU]

Bakıyorum kardeşim

 

[Mustafa MUTLU]

Sayfa3 e bir düğme ekler ve o düğmeye aşağıdakı macroyu ata.
Deneyiniz sizin girdiğiniz veriler eşit değil yalnız
Doğru veri girerek deneyiniz..

Sub KONTROLET()

MM = 2
Sheets("Sayfa3").Range("e2:e65536").ClearContents
For MSTF1 = 2 To Sheets("Sayfa2").Cells(65536, "A").End(xlUp).Row
MUTLU1 = Sheets("Sayfa2").Cells(MSTF1, "a")
MUTLU2 = Sheets("Sayfa2").Cells(MSTF1, "b")

For MSTF2 = 2 To Sheets("Sayfa1").Cells(65536, "b").End(xlUp).Row
If Sheets("Sayfa1").Cells(MSTF2, "e") = MUTLU1 Then
If Sheets("Sayfa1").Cells(MSTF2, "b") = MUTLU2 Then

Sheets("Sayfa3").Cells(MM, "e") = Sheets("Sayfa3").Cells(MM, "e") + 1

End If
End If

Next MSTF2
MM = MM + 1
Next MSTF1
End Sub

 

[ADER_34]

Çok teşekkür ederim Mustafa bey kodlar çalışıyor,sorunum kısmen çözüldü bazı eksiklikler var,eğer zahmet olmazsa farklı kullandığım veri aktarımı yaptığım kodlarda düzeltme yapmak istiyorum kodlar şöyle
Sub SCRAP()
TextBox1 = ""
ZBasla = TimeValue(Now)
zaman = Timer

For a = 2 To [N65536].End(xlUp).Row
If Cells(a, 14) <> "" Then TextBox1 = Trim(TextBox1 & " " & Cells(a, 14))
Next a
Application.ScreenUpdating = False
Range("A2:I" & Rows.Count).ClearContents
Dim mesaj$
mesaj = "Islem Tamamlandi."
If Me.TextBox1.Text <> Empty Then
'Dim i As Long
Dim son_satir&, bul As Range, ilk_adres$, silinecekler As Range
'a = Split(Replace(TextBox1.Text, " ", ""), ",")'
a = Split(Trim(TextBox1.Text), " ")
For s = LBound(a) To UBound(a)
Set bul = Sayfa1.Columns("B").Find(a(s), , , xlPart)
If Not bul Is Nothing Then
ilk_adres = bul.Address
Set silinecekler = bul
Do
Set silinecekler = Union(silinecekler, bul)
son_satir = Cells(Rows.Count, 1).End(3).Row + 1
Range("A" & son_satir & ":M" & son_satir).Value = Sayfa1.Range("A" & bul.Row & ":M" & bul.Row).Value
Set bul = Sayfa1.Columns("B").FindNext(bul)
Loop While Not bul Is Nothing And bul.Address <> ilk_adres
'silinecekler.EntireRow.Delete
Else
mesaj = "Aranan Koli no bulunamadi."
End If
Next s
Set bul = Nothing: son_satir = Empty: ilk_adres = Empty: Set silinecekler = Nothing
End If
Application.ScreenUpdating = True
MsgBox mesaj, vbInformation, "BILGI"
mesaj = Empty
'TextBox1.Text = Empty
Application.ScreenUpdating = True
zBitis = TimeValue(Now)

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"


End Sub

bu kodlarda veri aktarılıan sayfada veriler silinmeden diğer verileri en son dolu satırdan alt alta devam ederek aktarması kodlara ileve olarak nasıl bir satır eklemeliyim kolay gelsin teekkürler..