• DİKKAT

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

MÜKERRER KAYIT

Katılım
9 Ekim 2019
Mesajlar
10
Excel Vers. ve Dili
Excel başlangıç
Arkadaşlar merhaba bir kütüphane kayıt vba üzerinden bir kütüphane kayıt programı yazıyorum acemi bir şekilde
Excel doyasında 2 sheet var ilk sheet aktif kayıt ekranı kitap teslim edilmeyen öğrenciler 2.sheet arşiv kitabı getiren öğrencilerin arşivlendiği ekran
benim isteğim ilk sheet de "D" sütunu yani öğrenci numarasına göre kayıt yapılıyor arama yine d sutununda bir öğrenci ilk kitabı getirmeden ikinci kitabı alamıyor kütüphane kuralları gereği bu kuralı programa da yazmak istiyorum fakat beceremedim
özet olarak 2.sheete taşınmadan 2. kaydın açılmasını istemiyorum (ana hücre öğrenci numarası işlemler bu sutün üzerinden devam ediyor
Kod:
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim aranan, sil_satır As Variant
Set ws = Worksheets("Ana Sayfa")

'find first empty row in database
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'check for a Name number
If Trim(Me.TextBox_on.Value) = "" Then
  Me.TextBox_on.SetFocus
  MsgBox "Lütfen Öğrenci Numarasını Giriniz"
  Exit Sub
End If

'copy the data to the database
ws.Cells(iRow, 2).Value = Me.TextBox_ıd.Value
ws.Cells(iRow, 3).Value = Me.TextBox_ka.Value
ws.Cells(iRow, 4).Value = Me.TextBox_on.Value
ws.Cells(iRow, 5).Value = Me.TextBox_snf.Value
ws.Cells(iRow, 6).Value = Me.TextBox_ad.Value
ws.Cells(iRow, 7).Value = Me.TextBox_os.Value
ws.Cells(iRow, 8).Value = Me.TextBox_at.Value
ws.Cells(iRow, 9).Value = Me.TextBox_vt.Value

MsgBox "KAYIT YAPILDI", vbOKOnly + vbInformation, "Veri Kaydedildi"
Cells.Select
Cells.EntireColumn.AutoFit

'clear the data
Me.TextBox_ıd.Value = ""
Me.TextBox_ka.Value = ""
Me.TextBox_on.Value = ""
Me.TextBox_snf.Value = ""
Me.TextBox_ad.Value = ""
Me.TextBox_os.Value = ""
Me.TextBox_at.Value = ""
Me.TextBox_vt.Value = ""
Me.TextBox_on.SetFocus
Exit Sub
End Sub
 
Örnek dosya olsaydı iyi olurdu.

Anlattıklarınızdan yola çıkarak veri doğrulama ile yapabilirsiniz:

D1'den itibaren aşağı doğru istediğiniz kadar seçin
Veri doğrulama menüzünden İzin verilen kısmında Özel'i seçin ve alttaki formül alanına aşağıdaki formülü yazın:

=EĞERSAY(D:D;D1)=1

Böylece D sütununa aynı veri sadece 1 kez yazılabilecektir.
 
Örnek dosya olsaydı iyi olurdu.

Anlattıklarınızdan yola çıkarak veri doğrulama ile yapabilirsiniz:

D1'den itibaren aşağı doğru istediğiniz kadar seçin
Veri doğrulama menüzünden İzin verilen kısmında Özel'i seçin ve alttaki formül alanına aşağıdaki formülü yazın:

=EĞERSAY(D:D;D1)=1

Böylece D sütununa aynı veri sadece 1 kez yazılabilecektir.
https://drive.google.com/file/d/1gYoFlzwRQaxfxSP_QgdFQUrRn1Qzq9ln/view?usp=sharing
buradan ulaşabilirsiniz.
 
Belirttiğim işlemi aynen uyguladığınızda istediğiniz gerçekleşiyor.
 
Geri
Üst