• DİKKAT

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

Sayfada varsa değiştir yoksa ekle

Katılım
30 Kasım 2006
Mesajlar
411
Excel Vers. ve Dili
Excel 2007 - Türkçe
Veri Sayfasındaki kayıtlarda girilen veri varsa değişiklikleri uygulasın, yoksa en son dolu hücreye eklesin.
Kodu hazırladım ama çalışmadı hatam nerede çözemedim... Yardımlarınız için şükranlarımı sunarım....

Dim sat As Integer
For sat = 1 To Sheets("menu").Cells(65536, "A").End(3).Row
If Sheets("menu").Cells(sat, "A") = TextBox6.Value And Sheets("menu").Cells(sat, "B") = IŞLM1.Value And Sheets("menu").Cells(sat, "F") = Label35.Caption Then
Sheets("menu").Cells(sat, 1).Value = TextBox6.Text
Sheets("menu").Cells(sat, 2).Value = IŞLM1.Text
Sheets("menu").Cells(sat, 3).Value = ÜCR1.Text
Sheets("menu").Cells(sat, 4).Value = TEDG1.Text
Sheets("menu").Cells(sat, 5).Value = KASA1.Text
Sheets("menu").Cells(sat, 6).Value = Label35.Caption
Sheets("menu").Cells(sat, 7).Value = TextBox2.Text

Else

sat = Sheets("menu").Range("a65536").End(xlUp).Row + 1
Sheets("menu").Cells(sat, 1).Value = TextBox6.Text
Sheets("menu").Cells(sat, 2).Value = IŞLM1.Text
Sheets("menu").Cells(sat, 3).Value = ÜCR1.Text
Sheets("menu").Cells(sat, 4).Value = TEDG1.Text
Sheets("menu").Cells(sat, 5).Value = KASA1.Text
Sheets("menu").Cells(sat, 6).Value = Label35.Caption
Sheets("menu").Cells(sat, 7).Value = TextBox2.Text

End If
Next
 
Veri Sayfasındaki kayıtlarda girilen veri varsa değişiklikleri uygulasın, yoksa en son dolu hücreye eklesin.
Kodu hazırladım ama çalışmadı hatam nerede çözemedim... Yardımlarınız için şükranlarımı sunarım....

Dim sat As Integer
For sat = 1 To Sheets("menu").Cells(65536, "A").End(3).Row
If Sheets("menu").Cells(sat, "A") = TextBox6.Value And Sheets("menu").Cells(sat, "B") = IŞLM1.Value And Sheets("menu").Cells(sat, "F") = Label35.Caption Then
Sheets("menu").Cells(sat, 1).Value = TextBox6.Text
Sheets("menu").Cells(sat, 2).Value = IŞLM1.Text
Sheets("menu").Cells(sat, 3).Value = ÜCR1.Text
Sheets("menu").Cells(sat, 4).Value = TEDG1.Text
Sheets("menu").Cells(sat, 5).Value = KASA1.Text
Sheets("menu").Cells(sat, 6).Value = Label35.Caption
Sheets("menu").Cells(sat, 7).Value = TextBox2.Text

Else
'sat = Sheets("menu").Range("a65536").End(xlUp).Row + 1
Sheets("menu").Cells(sat, 1).Value = TextBox6.Text
Sheets("menu").Cells(sat, 2).Value = IŞLM1.Text
Sheets("menu").Cells(sat, 3).Value = ÜCR1.Text
Sheets("menu").Cells(sat, 4).Value = TEDG1.Text
Sheets("menu").Cells(sat, 5).Value = KASA1.Text
Sheets("menu").Cells(sat, 6).Value = Label35.Caption
Sheets("menu").Cells(sat, 7).Value = TextBox2.Text

End If
Next



Sorunu Çözememişim.......
 
Son düzenleme:
Veri Sayfasındaki kayıtlarda girilen veri varsa değişiklikleri uygulasın, yoksa en son dolu hücreye eklesin.
Kodu hazırladım ama çalışmadı hatamın nerede olduğunu çözdümğümü zannettim ama çözememişim.. Yardımlarınız için şükranlarımı sunarım....
 
Tüm satırları kontrol edip sonra kayıt yapması için aşağıdaki gibi deneyin.


Kod:
 Dim sat As Integer
For sat = 1 To Sheets("menu").Cells(65536, "A").End(3).Row
If Sheets("menu").Cells(sat, "A") = TextBox6.Value And [COLOR="Red"]Sheets("menu").Cells(sat, "B") = IŞLM1.Value And[/COLOR] Sheets("menu").Cells(sat, "F") = Label35.Caption Then
Sheets("menu").Cells(sat, 1).Value = TextBox6.Text
Sheets("menu").Cells(sat, 2).Value = IŞLM1.Text
Sheets("menu").Cells(sat, 3).Value = ÜCR1.Text 
Sheets("menu").Cells(sat, 4).Value = TEDG1.Text
Sheets("menu").Cells(sat, 5).Value = KASA1.Text
Sheets("menu").Cells(sat, 6).Value = Label35.Caption
Sheets("menu").Cells(sat, 7).Value = TextBox2.Text

Exit Sub
End If
Next
sat = Sheets("menu").Range("a65536").End(xlUp).Row + 1
If Cells(1, 1) = "" Then sat = 1

Sheets("menu").Cells(sat, 1).Value = TextBox6.Text
Sheets("menu").Cells(sat, 2).Value = IŞLM1.Text
Sheets("menu").Cells(sat, 3).Value = ÜCR1.Text
Sheets("menu").Cells(sat, 4).Value = TEDG1.Text
Sheets("menu").Cells(sat, 5).Value = KASA1.Text
Sheets("menu").Cells(sat, 6).Value = Label35.Caption
Sheets("menu").Cells(sat, 7).Value = TextBox2.Text
 
Son düzenleme:
Tüm satırları kontrol edip sonra kayıt yapması için aşağıdaki gibi deneyin.


Kod:
 Dim sat As Integer
For sat = 1 To Sheets("menu").Cells(65536, "A").End(3).Row
If Sheets("menu").Cells(sat, "A") = TextBox6.Value And Sheets("menu").Cells(sat, "B") = IŞLM1.Value And Sheets("menu").Cells(sat, "F") = Label35.Caption Then
Sheets("menu").Cells(sat, 1).Value = TextBox6.Text
Sheets("menu").Cells(sat, 2).Value = IŞLM1.Text
Sheets("menu").Cells(sat, 3).Value = ÜCR1.Text 
Sheets("menu").Cells(sat, 4).Value = TEDG1.Text
Sheets("menu").Cells(sat, 5).Value = KASA1.Text
Sheets("menu").Cells(sat, 6).Value = Label35.Caption
Sheets("menu").Cells(sat, 7).Value = TextBox2.Text

Exit Sub
End If
Next
sat = Sheets("menu").Range("a65536").End(xlUp).Row + 1
If Cells(1, 1) = "" Then sat = 1

Sheets("menu").Cells(sat, 1).Value = TextBox6.Text
Sheets("menu").Cells(sat, 2).Value = IŞLM1.Text
Sheets("menu").Cells(sat, 3).Value = ÜCR1.Text
Sheets("menu").Cells(sat, 4).Value = TEDG1.Text
Sheets("menu").Cells(sat, 5).Value = KASA1.Text
Sheets("menu").Cells(sat, 6).Value = Label35.Caption
Sheets("menu").Cells(sat, 7).Value = TextBox2.Text


Yukardaki kod kişiye ait Kayıt olduğu halde tekrar yeni kayıt yapmaktadır.
Benim İsteğim "f sütununda = Label35.Caption tarihli, ve a sütununda =TextBox6 da ki TC" ye ait bilgi varsa güncellesin yoksa eklesin.. İkili Sorgulama şeklinde

Aynı Kişiye ait ayrı günlerde Bir çok Kayıt olabileceğinden Gün ve Tc yi ikili sorgulatmalıyım..
 
Yukardaki kod kişiye ait Kayıt olduğu halde tekrar yeni kayıt yapmaktadır.
Benim İsteğim "f sütununda = Label35.Caption tarihli, ve a sütununda =TextBox6 da ki TC" ye ait bilgi varsa güncellesin yoksa eklesin.. İkili Sorgulama şeklinde
Label35.Caption ve TextBox6 ya göre olması yeterli ise yukarıda gönderdiğim
koddaki kırmızı bölümü silerek deneyiniz.
 
Geri
Üst