bul değiştir

[turk4545]

mrb.ekteki form da bilgileri girip kaydet deyince sayfa 2 ye alt alta kaydediyor. aynı kaydı tekrar yapacagım zaman tc yazıp bul diyorum diğer bilgiler geliyor ve onlarıda kaydet deyince yeni kayıt yapıyor.istedim buldugu kaydın üzerine yazması.yeni kayıtsa öyle alt alta eklemesi..yardımcı olurmusunuz..

 

[turk4545]

Private Sub CommandButton4_Click()
Application.ScreenUpdating = False
On Error GoTo hata
Sheets("Sayfa2").Select
Sheets("Sayfa2").Range("A:A").Find(Sheets("Sayfa1").Range("B1").Value, LookIn:=xlValues, LookAt:=xlWhole).Select
If hata = True Then
hata: MsgBox "Böyle bir kayıt bulunmamaktadır.", vbCritical, "Dikkat"
Sheets("Sayfa1").Select
Exit Sub
End If
Set bul = Sheets("Sayfa2").Range("A:A").Find(Sheets("Sayfa1").Range("B1").Value, LookIn:=xlValues, LookAt:=xlWhole)
Set Son = ActiveCell.Offset(0, 7)
Range(bul, Son).Copy
Sheets("Sayfa1").Select
Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
[B1].Select
Application.CutCopyMode = xlCopy
TextBox2.Value = [b2]
TextBox3.Value = [B3]
ComboBox1.Value = [b4]
TextBox4.Value = [B5]
TextBox5.Value = [b6]
TextBox6.Value = [B7]
End Sub



bul kodları bunlar..dosyayı ekleyemedim.sorun var galiba

 

[leumruk]

Eğer, tcno kayıtlarda varsa kaydetmesini engellemesini mi istiyorsunuz; yoksa üzerine kaydetmesini mi? Her iki durumda da kayıt kodlarını eklemeniz gerekiyor. Bul kodu, verilerinizi getirmeye yarar, kayıtla bir ilgisi yok.

 

[turk4545]

demek istediğim eğer kayıt varsa üzerine yazsın,yeni kayıt yapmasın

 

[turk4545]

Private Sub CommandButton1_Click()
[B1:B7].Copy
Sheets("Sayfa2").Select
Sat = [A65536].End(3).Row + 1
Cells(Sat, "a").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Sayfa1").Select
Application.CutCopyMode = xlCopy
End Sub


kaydet kodu da bu..

 

[turk4545]

bu konudaki sıkıntıyıda söyleyeyim..verileri alt alta kaydediyor.yaklaşık olarak 25000 e yakın satır var elimde.bul dediğimde çok yavaşlıyor.bu veriler günden güne artıyor...

 

[leumruk]

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
On Error GoTo Hata
[B1:B7].Copy
Set Bul = Sheets("Sayfa2").Range("A:A").Find(Sheets("Sayfa1").Range("B1").Value, LookIn:=xlValues, LookAt:=xlWhole)
Bul.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = xlCopy
Sheets("Sayfa1").Select
Exit Sub
Hata:
Sheets("Sayfa2").Select
Sat = [A65536].End(3).Row + 1
Cells(Sat, "a").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Sayfa1").Select
Application.CutCopyMode = xlCopy
End Sub

Kodu dener misiniz?

 

[turk4545]

hocam çok teşekkür.istediğim oldu.eline sağlık..

 

[leumruk]

Rica ederim.