• DİKKAT

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

Çalışmamı asıl programa uyarlayamadım...

  • Konbuyu başlatan Konbuyu başlatan vaskal
  • Başlangıç tarihi Başlangıç tarihi
Katılım
15 Ağustos 2007
Mesajlar
97
Excel Vers. ve Dili
excell 2003 türkçe
Kayıt ekleyip silme ile ilgili bir sayfalık bir çalışma yaptım. Tüm hatalarını ayıkladım. Makrolardan çok fazla anlamadığım halde biraz özellikte ekledim. fakat gelin görünki bu deneme çalışmasını asıl programıma uyarlayamadım...

Yani sözün kısası yüzdümyüzdüm kuyruğuna geldim orada takıldım kaldım. Yardımedecek arkadaşlara teşekkür ederim.
 
Ekli dosyayı deneyiniz.:cool:
Kod:
say = WorksheetFunction.CountA(Range("B2:B65000")) + 1
 
Orion2 ilgine teşekkür. Ancak bu değişiklikleri bende yapmıştım. Senin gönderdiğinde de hata devam ediyor. Mesela Userform'u kullanarak bir kayıt ekleyin. Kaydedin. Sıra No ilk kayıtta 1 olması gerekirken 2 oluyor. Bunun gibi birkaç kayıt yapın. Daha sonra Okul No yu yazarak tekrar BUL ile buldurmaya çalıştığımızda en son satıra gelen kaydı bulmuyor. Halbuki Aradığımız Kayıt var(Yani hata anladığım kadarıyla ilk kayıtta Sıra No 1 yerine 2 yazmasından kaynaklanıyor. Fakat ben bu hatayı düzeltemiyorum)...Dediğim gibi 1. satırı satır olarak tamamen kaldırırsak hatasız çalışıyor.
 
Kod:
say = WorksheetFunction.CountA(Range("B1:B65000"))
    txtsira.Value = say
    Cells(say + 1, 1).Value = txtsira.Value[COLOR=red] - 1[/COLOR]

Sıra numarası verirken üstte 2 satırınız var. İkisinin de dolu olduğunu varsayarsak;

WorksheetFunction.CountA(Range("B1:B65000"))

Bu fonksiyon 2 sonucunu döndürür. Dolayısı ile başlangıç sıra numaranız 2 olur.
1 olması için -1 kısmını ilave edin.
 
Kaydet Kodunu Aşağıdaki gibi

Kod:
Private Sub CommandButton2_Click()
 For d = 1 To 1
     If Controls("textbox" & d) = "" Then
    MsgBox "Öğrencinin Okul Numarasını Girmediniz !"
    Exit Sub
    End If
Next
    For a = 2 To 7
    If Controls("textbox" & a) = "" Then
    MsgBox "Mavi Alanların Hepsini Doldurunuz !"
    Exit Sub
    End If
Next
For b = 10 To 11
    If Controls("textbox" & b) = "" Then
    MsgBox "Mavi Alanların Hepsini Doldurunuz !"
    Exit Sub
    End If
Next
For c = 10 To 12
    If Controls("textbox" & c) = "" Then
    MsgBox "Öğrencinin Cinsiyetini Seçmediniz !"
    Exit Sub
    End If
Next
Dim bak As Range
    Dim say As Integer
    For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65536")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox1.Value, vbUpperCase) Then
            MsgBox "Bu Numara Önceden Kaydedilmiş. Başka Bir Okul No Kullanınız."
             Exit Sub
        End If
    Next bak
    For Each bak In Range("D1:D" & WorksheetFunction.CountA(Range("D1:D65536")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox3.Value, vbUpperCase) Then
            MsgBox "Bu Öğrenci Sitemde Zaten Kayıtlı. Yada T.C.Kimlik Numarasını Yanlış Girdiniz."
            Exit Sub
        End If
    Next bak
    say = WorksheetFunction.CountA(Range("B2:B65000")) + 1
    txtsira.Value = say - 1
    Cells(say + 1, 1).Value = txtsira.Value
    Cells(say + 1, 2).Value = TextBox1.Value * 1
    Cells(say + 1, 3).Value = TextBox2.Value
    Cells(say + 1, 4).Value = TextBox3.Value * 1
    Cells(say + 1, 5).Value = TextBox4.Value
    Cells(say + 1, 6).Value = TextBox5.Value
    Cells(say + 1, 7).Value = TextBox6.Value
    Cells(say + 1, 8).Value = TextBox7.Value
    Cells(say + 1, 10).Value = TextBox8.Value
    Cells(say + 1, 11).Value = TextBox9.Value
    Cells(say + 1, 12).Value = TextBox10.Value
    Cells(say + 1, 13).Value = TextBox11.Value
    Cells(say + 1, 9).Value = TextBox12.Value


    
    ThisWorkbook.Save
    MsgBox "Bilgiler Sisteme Kaydedildi", , "KAYIT"
    CommandButton5_Click
    
    txtsira.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1

End Sub

Bul kodunuda

Kod:
Private Sub CommandButton1_Click()
    Dim bak As Range
    If TextBox1.Value = "" Then
            MsgBox "Önce Aradığınız Öğrencinin Okul Numarasını Girmelisiniz !"
            Exit Sub
        End If
    For Each bak In Range("B3:B" & WorksheetFunction.CountA(Range("B3:B65000")))
    If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox1.Value, vbUpperCase) Then
            bak.Select
            txtsira.Value = ActiveCell.Offset(0, -1).Value
            TextBox2.Value = ActiveCell.Offset(0, 1).Value
            TextBox3.Value = ActiveCell.Offset(0, 2).Value
            TextBox4.Value = ActiveCell.Offset(0, 3).Value
            TextBox5.Value = ActiveCell.Offset(0, 4).Value
            TextBox6.Value = ActiveCell.Offset(0, 5).Value
            TextBox7.Value = ActiveCell.Offset(0, 6).Value
            TextBox8.Value = ActiveCell.Offset(0, 8).Value
            TextBox9.Value = ActiveCell.Offset(0, 9).Value
            TextBox10.Value = ActiveCell.Offset(0, 10).Value
            TextBox11.Value = ActiveCell.Offset(0, 11).Value
            TextBox12.Value = ActiveCell.Offset(0, 7).Value
                
    CommandButton2.Enabled = False
    CommandButton3.Enabled = True
    CommandButton4.Enabled = True
            
            Exit Sub
        End If

    Next bak
    MsgBox "Aradığınız Kayıt Bulunamadı !"
   
End Sub

şeklinde değiştirirseniz sorun hallolacaktır.
 
Hay Allah razı olsun. 3 sattir bununla uğraşıyorum. Şimdi oldu.

AS3434 Peki birinci satır boş olursa nasıl yapmak lazım. Çünkü 1. satırda Diğer sayfalara geçiş için kullandığım makroları çalıştıran BUTONLAR var.(Gerçi 1. satırdaki hücreleri görünmeyecek şekilde * ile doldurdum program çalışıyor. Ben yine de öğrenmek isterim.)

Orion2 seninkindede silince hata yapıyor. Sil komutlarınıda verirsen sevinirim. Birde 12. satırdan sonraki verileri bulmuyor...Anlayamadım gitti.
 
Son düzenleme:
Orion2 seninkindede silince hata yapıyor. Sil komutlarınıda verirsen sevinirim. Birde 12. satırdan sonraki verileri bulmuyor...Anlayamadım gitti.
Ekli dosyayı inceleyiniz.Sanırım bu sefer oldu.:cool:
 
Orion2 ilgilendiğin için teşekkürler. Kayıt sildiğimde A2 deki sıra no yazısını silip 1 yazıyor. sonra kayıt ekleyince sıra no ları karışıyor. AS3434 ün yöntemini kullanıyorum artık.(1. satırı görünmeyecek şekilde karakterlerle doldurdum ve kilitledim. Şu anda sorunsuz çalışıyor. Yalnız onunkinde de SİL komutunda hata çıkıyordu Onu da SİL komutunu
say = WorksheetFunction.CountA(Range("A3:A65000"))
For i = 1 To say
Cells(i + 2, 1) = i

şeklinde değiştirdim. Dediğim gibi şu anda bir problem gözükmüyor....
 
Geri
Üst