Soru Geri alma kodu (excel VBA)

Katılım
30 Eylül 2021
Mesajlar
3
Excel Vers. ve Dili
365 vba
Altın Üyelik Bitiş Tarihi
06-06-2023
Merhaba elimde kurumumuzda kullanılan randevu cagırma kodlaması var. butona basınca sıradaki cıkıyor ve OGRENCI Sheetsi içinde a2 b2 c2 de görünüyor. ancak bana bir de farklı bir butona basınca geçtiğimiz randevulara giden yani bir önceki bir önceki bir önceki..... (OGRENCI sheetsi içinde c2 d2 e2 sütunlarında görünen) bir kod lazım. bu konuda yardımcı olabilir misiniz?

Kod:
Private Sub btnSiradaki_Click()
Dim h As Byte
Dim ss As Byte
Dim x As Byte
ss = Sheets("OGRENCI").Range("A1000").End(xlUp).Row
For x = 2 To ss
    If Sheets("OGRENCI").Range("D" & x).Value = "" Then
        Sheets("MONITOR").Rows(2).EntireRow.Delete
        Sheets("MONITOR").Range("A2").Value = Sheets("OGRENCI").Range("A" & x).Value
        Sheets("MONITOR").Range("B2").Value = Sheets("OGRENCI").Range("B" & x).Value
        Sheets("MONITOR").Range("C2").Value = Sheets("OGRENCI").Range("C" & x).Value
        Sheets("OGRENCI").Range("D" & x).Value = "X"
        Exit For
    End If
Next
End Sub
 

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Merhaba , aşağıdaki kodları deneyiniz..

Kod:
Private Sub btnSiradaki_Click()
Dim h As Byte, ss As Byte, x As Byte
ss = Sheets("OGRENCI").Range("A1000").End(xlUp).Row
For x = 2 To ss
    If Sheets("OGRENCI").Range("D" & x).Value = "" Then
        Sheets("MONITOR").Rows(2).EntireRow.Delete
        Sheets("OGRENCI").Range("E2:E1000").ClearContents
        Sheets("MONITOR").Range("A2").Value = Sheets("OGRENCI").Range("A" & x).Value
        Sheets("MONITOR").Range("B2").Value = Sheets("OGRENCI").Range("B" & x).Value
        Sheets("MONITOR").Range("C2").Value = Sheets("OGRENCI").Range("C" & x).Value
        Sheets("OGRENCI").Range("D" & x).Value = "X"
        Exit For
    End If
Next
End Sub

Private Sub btnOnceki_Click()
    Dim Son As Integer, Say As Integer
    Say = Application.WorksheetFunction.CountA(Sheets("OGRENCI").Range("E2:E1000"))
    If Say = 0 Then
        Son = Sheets("OGRENCI").Range("D1000").End(xlUp).Row - 1
    Else
        Son = Sheets("OGRENCI").Range("E1000").End(xlUp).Row - Say
    End If
    If Son > 1 Then
            Sheets("MONITOR").Range("D2").Value = Sheets("OGRENCI").Range("A" & Son).Value
            Sheets("MONITOR").Range("E2").Value = Sheets("OGRENCI").Range("B" & Son).Value
            Sheets("MONITOR").Range("F2").Value = Sheets("OGRENCI").Range("C" & Son).Value
            Sheets("OGRENCI").Range("E" & Son).Value = "X"
    End If
End Sub
 
Katılım
30 Eylül 2021
Mesajlar
3
Excel Vers. ve Dili
365 vba
Altın Üyelik Bitiş Tarihi
06-06-2023
Çok teşekkür ederim işe yaradı. Ancak bir sorunum var. Örneğin 4.sıradaki öğrencideyim, öncekine tıkladıım 3'e, bir daha tıkladım 2'ye gitti. Bu kez sıradaki butonuna tıkladığımda 5'den devam ediyor. Oysa 2'deydim, 3.ye geçmesini istiyorum. İlk sorumda yanlış belirtmiş ya da eksik belirtmiş olabilirim. Henüz yeni yeni başladım excel vba ya, kusura bakmayın :)
 

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Merhaba , estağfurullah ortada bir kusur yok ben o şekilde anlamıştım , o zaman kodları aşağıdaki gibi değiştiriniz. Forum'a hoşgeldiniz bu arada .

Kod:
Private Sub btnSiradaki_Click()
    Dim h As Byte, ss As Byte, x As Byte
    ss = Sheets("OGRENCI").Range("A1000").End(xlUp).Row
    For x = 2 To ss
        If Sheets("OGRENCI").Range("D" & x).Value = "" Then
            Sheets("MONITOR").Rows(2).EntireRow.Delete
            Sheets("MONITOR").Range("A2").Value = Sheets("OGRENCI").Range("A" & x).Value
            Sheets("MONITOR").Range("B2").Value = Sheets("OGRENCI").Range("B" & x).Value
            Sheets("MONITOR").Range("C2").Value = Sheets("OGRENCI").Range("C" & x).Value
            Sheets("OGRENCI").Range("D" & x).Value = "X"
            Exit For
        End If
    Next
End Sub

Private Sub btnOnceki_Click()
    Dim Son As Integer
    Son = Sheets("OGRENCI").Range("D1000").End(xlUp).Row - 1
    If Son > 1 Then
            Sheets("MONITOR").Range("D2").Value = Sheets("OGRENCI").Range("A" & Son).Value
            Sheets("MONITOR").Range("E2").Value = Sheets("OGRENCI").Range("B" & Son).Value
            Sheets("MONITOR").Range("F2").Value = Sheets("OGRENCI").Range("C" & Son).Value
            Sheets("OGRENCI").Range("D" & Son + 1).Value = ""
    End If
End Sub
 
Katılım
30 Eylül 2021
Mesajlar
3
Excel Vers. ve Dili
365 vba
Altın Üyelik Bitiş Tarihi
06-06-2023
Gerçekten çok teşekkür ederim. Şahane oldu. Aradım ama bir türlü bulamadım. Bir butona tıklaması için tuş ataması yapabiliyor muyuz?
 
Üst