Kayıt Makrosu Yardım.

[uKiGS]

Merhaba arkadaşlar.

Dosyamda isimler ve yanlarında da farklı olarak 3 numara var. Kayıt etmek istiyorum bunları ve kayıt makrosu yapmaya çalıştım. Fakat ilk sütundakileri kayıt ediyorum ama daha sonrasındaki sütunları kayıt etmeyi bir türlü beceremedim. Çok yetmedi makro bilgim buna açıkcası

Sizden değerli yardımlarınızı rica ediyorum. Herkese şimdiden teşekkürlerimi sunarım.

 

[uKiGS]

Bir de dosyada örneği yok ama mesela Numara 1 Numara 2 ve Numara 3 hepsi boşsa kayıt yapmasın. Atıyorum Ahmet Veli isimleri mevcut ama Numaraları yok onların o zaman kaydet dediğim de kayıt sayfasına onu eklemesin. Değerli yardımlarınız benim için çok önemli. Bu listenin ham hali bunu 200 kişilik bir listeye uyarlayacağım. Şimdiden çok teşekkür ediyorum.

Not: Alt Alta kaydı yaptım fakat tümü boş olanları kayıt ettirmeyi bulamadım. O konuda yardımcı olacak arkadaş var mıdır acaba aramızıda?

 

[YUSUF44]

Mevcut makronuzu aşağıdakiyle değiştirip deneyiniz:

Sub aktar()

Application.ScreenUpdating = False

Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")

s2.Columns("B:R").HorizontalAlignment = xlCenter

son1 = s1.Cells(Rows.Count, "B").End(3).Row

For i = 2 To son1 Step 2
    If s1.Cells(i, "C") <> "" Or s1.Cells(i, "C") <> "" Or s1.Cells(i, "C") <> "" Then
        yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
        s2.Cells(yeni, "A") = s1.Cells(i, "B")
        s2.Cells(yeni, "B") = s1.Cells(i + 1, "B")
        s2.Cells(yeni, "C") = s1.Cells(i, "C")
        s2.Cells(yeni, "D") = s1.Cells(i, "D")
        s2.Cells(yeni, "E") = s1.Cells(i, "E")
    End If
Next

Application.ScreenUpdating = True

ActiveWorkbook.Save
 
MsgBox " Kayıt Başarılı Şekilde Yapılmıştır."

End Sub

 

[uKiGS]

Yardımlarınız için teşekkür ederim.
Ama sanırım benim eksik veri yollamamdan kaynaklı sorun var. Ben size verilerin tam halini atıp göndersem ona göre verirseniz kodu sevinirim. Kayıt sayfasında gerekli olmayacak sütunları gizledim. B3, B4, O2,P2 ve Q2 ilk kayıt yapılacak yer. sonrasında da B6,B7,O5,P5,Q5 şeklinde 40 kişiye kadar bir kayıt ekleyeceğim.
İyi günler.

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Sub aktar()

Application.ScreenUpdating = False

Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")

s2.Columns("B:R").HorizontalAlignment = xlCenter

son1 = s1.Cells(Rows.Count, "B").End(3).Row

For i = 2 To son1 Step 3
    If s1.Cells(i, "O") <> "" Or s1.Cells(i, "P") <> "" Or s1.Cells(i, "Q") <> "" Then
        yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
        s2.Cells(yeni, "A") = s1.Cells(i + 1, "B")
        s2.Cells(yeni, "B") = s1.Cells(i + 2, "B")
        s2.Cells(yeni, "C") = s1.Cells(i, "O")
        s2.Cells(yeni, "D") = s1.Cells(i, "P")
        s2.Cells(yeni, "E") = s1.Cells(i, "Q")
    End If
Next

Application.ScreenUpdating = True

ActiveWorkbook.Save
 
MsgBox " Kayıt Başarılı Şekilde Yapılmıştır."

End Sub

Bu vesileyle, örnek dosyanızın asıl dosyanızla aynı yapıda olması gerektiğini görmüş oldunuz.

 

[uKiGS]

Verdiğiniz destek için çok teşekkür ederim. Elinize emeğinize sağlık bu dosyam sayenizde çalışır vaziyette oldu. Peki bir sorum daha olacak affınıza sığınarak. Başka bir dosyam daha var ama bunda B3 yerine B14 de başlıyor kayıt işlemi. Bunun için yukarıda verdiğiniz makroda nereyi düzenlemem gerekir?

 

[uKiGS]

For i = 2 To son1 Step 2
bu kısmı değiştirerek yaptım ve oldu.
Tekrardan teşekkür ederim emekleriniz için

 

[uKiGS]

Aynı excel için bir de eğer formülü yazmak istiyorum ama yardımcı olabilir misiniz? Kayıt sayfasına F2 hücresine toplam ortalamalarını alıp G2 , H2, I2 hücrelerine sırasıyla =EĞER(F2>65;"Başarılı";"Başarısız") =EĞER(F2>85;"Başarılı";"Başarısız") =EĞER(F2>45;"Başarılı";"Başarısız") Formülünü yazıyorum buraya kadar tamam ama mesala D2 hücrem boş ise H2 hücresininde boş kalmasını istiyorum. Bazı zamanlarda bu hücre boş olabiliyor. Ekli dosyada sarı ile işaretli olan yerde de Başarılı ya da başarısız yazmasın orası da boş kalsın istiyorum. Herkese yardımları için teşekkürler.

 

[YUSUF44]

Deneyiniz:

=EĞER(D2="";"";EĞER(F2>65;"Başarılı";"Başarısız"))

 

[uKiGS]

Çok teşekkür ederim. Emeğinize sağlık.

Peki D2 hücrem dolu ama F2 hücrem boşsa nasıl bir formül eklenebilir? Tam tersi bir durumda da çünkü F2 ye ortalama eklemediğim zaman bu formülde orada da "Başarısız" yazısı ekleniyor da.

 

[uKiGS]

=EĞER(D2="";"";EĞER(F2="";"";EĞER(F2>=8;"Başarılı";"Başarısız")))

bu formülü yazdığımda işimi gördü. Sayenizde verdiğiniz örnekler üzerinden deneye deneye bende kendimce bir şeyler öğreniyorum. Forumda emeği geçen tüm arkadaşlara teşekkür ederim. İyi ki varsınız.

 

[YUSUF44]

Deneyiniz:

=EĞER(YADA(F2="";D2="");"";EĞER(F2>65;"Başarılı";"Başarısız"))

Başka ayrıntılar da varsa lütfen hepsini topluca sorunuz.