Ekteki Makrolu dosyaya ilave işlemde yardım..

[smile80]

Arkadaslar ekteki excell dosyasında " GENEL LISTE " VE "SMS METNI " Bölümlerini aktif olarak kullanıyorum.
E-Okuldan almış olduğum devamsızlık listesini "GENEL LISTE" Ye aktarmak istiyorum.yapmak istediğimi özetleyecek
olursak.
1-) E-okul sayfasındaki G sutununda bulunan devamsızlık sayılarını "genel lıste" sayfasındaki ilgili kişinin "E" sutununa yani
devamsızlık sutununa kopyalamak istiyorum.Bunu "DEGERLERİ SIFIRLA" Butonunun altına yaparsak iyi olur..

2-) Mevcut halinda ben devamsızlık sutununa 1 yazdığımda mesaj "BU GUN OKULA GELMEMİŞTİR" Olarak gönderiyorum
şimdi ise "E-OKUL DEMASIZLIK" sayfasındaki F Sutunundaki tarihide dikkate alarak
1 yazanlar için,.../.../2011 TARIHINDE TAM GUN,
0,5 yazanlar için ise .../.../2011 TARIHINDE YARIM GUN okulumuza gelmemiştir olarak yazdırmak istiyorum.
Yardımlarınız için şimdiden teşekkür ederim

 

[smile80]

cevap yok mu..?

arkadaslar... bana yardımcı olacak kimse yok mu..?

 

[smile80]

değişiklik ben yaptım ama kodlar karıştı

ben bayagı ugrastım ama bir turlu olmadı lütfen yardım edin..teşekkürler

 

[smile80]

Gercektende cok zor bir istektemi bulundum..

Bu kadar zor bir istek mi acaba benimki... yok mu yardım edecek bir arkadas..?

 

[smile80]

?

her kes girip bakmış ama kimse yapamamış.. çok ilginç bende bir tek kendimi amatör görüyordum.. sadece bakıpta almayanlardan zannediyordum anladım ki öyle degil miş.. bu da güzel..

 

[halit3]

her kes girip bakmış ama kimse yapamamış.. çok ilginç bende bir tek kendimi amatör görüyordum.. sadece bakıpta almayanlardan zannediyordum anladım ki öyle degil miş.. bu da güzel..

MERHABA

Sayın smile80 dosyanızı açıp baktım bir şey anlıyamadım.

herhalde dosyanıza bakan kişilerde bir şey anlıyamamış olacaklarki kimse yardımcı olmamış.

Bu durumda sorunuzu gözden geçirirseniz belki çözüm yolu bulunabilir.

Örnek dosyanızda mevcut dürumu göze alarak yapılması gerekenlerin bir örneğini sayfanızın ilgili hücrelerini renklendirerek işlem yapınız.
Dosyayıda ekleyiniz bakalım.

 

[smile80]

dosya açıklamalaı olarak ekte sunulmustur.

Halit hocam inşallah derdimi anlatabilmişimdir.. elimden geldiğince açıklamalı yazdım. ilgi ve alakanıza teşekkür ederim..

 

[halit3]

Halit hocam inşallah derdimi anlatabilmişimdir.. elimden geldiğince açıklamalı yazdım. ilgi ve alakanıza teşekkür ederim..

1. sorun için kod

Sub Düğme7_Tıklat()
Dim satir As Integer
Dim sayi As Integer
sayi = Worksheets("GENEL LİSTE").Cells(17, 10).Value + 1
satir = Worksheets("SMS METNI").Cells(1, 1).Row
    For i = 2 To sayi Step 1
        Worksheets("GENEL LİSTE").Activate
        Worksheets("GENEL LİSTE").Cells(i, 5).Select
        If (ActiveCell.Value = 1) Then
            Worksheets("SMS METNI").Cells(satir, 1).Value = Worksheets("GENEL LİSTE").Cells(i, 1).Value
            Worksheets("SMS METNI").Cells(satir, 2).Value = "Sayın Velı, Öğrencimiz " & Worksheets("GENEL LİSTE").Cells(i, 2).Value & "  " & Worksheets("GENEL LİSTE").Cells(i, 6).Value & " tarihinde TAM gün okulumuza gelmemiştir"
            satir = satir + 1
            
            ElseIf (ActiveCell.Value = "0") Then
            Worksheets("SMS METNI").Cells(satir, 1).Value = Worksheets("GENEL LİSTE").Cells(i, 1).Value
            Worksheets("SMS METNI").Cells(satir, 2).Value = "Sayın Velı, Öğrencimiz " & Worksheets("GENEL LİSTE").Cells(i, 2).Value & "  " & Worksheets("GENEL LİSTE").Cells(i, 6).Value & " tarihinde YARIM gün okulumuza gelmemiştir"
            satir = satir + 1
            
            
        End If
    Next i
    Worksheets("GENEL LİSTE").Activate
    Range("A2").Select
    ActiveWorkbook.Save
End Sub

2. sorun için kod

Sub AKTAR()
For r = 2 To Worksheets("E-OKUL DEVAMSIZLIK").Cells(Rows.Count, "B").End(3).Row
aranan1 = Sheets("E-OKUL DEVAMSIZLIK").Cells(r, 2).Value
If Sheets("E-OKUL DEVAMSIZLIK").Cells(r, 2).Value <> "" Then
For i = r To Worksheets("E-OKUL DEVAMSIZLIK").Cells(Rows.Count, "B").End(3).Row
aranan2 = Sheets("E-OKUL DEVAMSIZLIK").Cells(i, 2).Value
If aranan2 = aranan1 Then
Sheets("GENEL LİSTE").Cells(i, 5).Value = Sheets("E-OKUL DEVAMSIZLIK").Cells(r, 7).Value
Sheets("GENEL LİSTE").Cells(i, 6).Value = Sheets("E-OKUL DEVAMSIZLIK").Cells(r, 6).Value
End If
Next i
End If
Next r
End Sub

 

[smile80]

Buton ile aktarım yapabilirmiyiz...

Hocam eline sağlık... yalnız E-OKUL DEVAMSIZLIK sayfasındaki Tarih (F Sutunu) ve devamsızlık rakamlarını (G Sutunu) bir buton ile genel listeye aktarım nasıl yapacağız.. bu konuda yardımcı olurmusunuz...

 

[halit3]

bir üsteki mesajımda kodu yazmıştım.
ekli dosyanıza bakınız.

 

[smile80]

Yarım gun gelmeyenler çıkmıyor hocam..

Hocam tam gun gelmeyenler olmuş ama 0,5 yazan, yarım gün gelmeyenler aktarım yapmıyor... Bir de buna bakarsanız sevinirim.. şimdiden teşekkür ederim..

 

[halit3]

Orda bir eksitlik olmuş kodun bu bölümünü

ElseIf (ActiveCell.Value = "0") Then

aşağıdaki ile değiştirin

ElseIf (ActiveCell.Value = "0,5") Then

 

[smile80]

Farmulde hata var..

Hocam.. Aktar butonuna bastığımızda genel listeye aktarırken öğrenci numarasını dikkate alarak degilde yukarıdan aşağıya sırayla aktarıyor.. Dolayısı ile devamsızlık yapan kişi degil de başka öğrenciye mesaj gidiyor... Tşk..

 

[halit3]

bunu düzttiydim herhalde başka konuda

Sub AKTAR()
For r = 2 To Worksheets("E-OKUL DEVAMSIZLIK").Cells(Rows.Count, "B").End(3).Row
aranan1 = Sheets("E-OKUL DEVAMSIZLIK").Cells(r, 2).Value
If Sheets("E-OKUL DEVAMSIZLIK").Cells(r, 2).Value <> "" Then
For i = 2 To Worksheets("GENEL LİSTE").Cells(Rows.Count, "B").End(3).Row
aranan2 = Sheets("GENEL LİSTE").Cells(i, 2).Value
If aranan2 = aranan1 Then
Sheets("GENEL LİSTE").Cells(i, 5).Value = Sheets("E-OKUL DEVAMSIZLIK").Cells(r, 7).Value
Sheets("GENEL LİSTE").Cells(i, 6).Value = Sheets("E-OKUL DEVAMSIZLIK").Cells(r, 6).Value
End If
Next i
End If
Next r
MsgBox "işlem tamam"
End Sub