Sınıf listesini aktar

[omeryılmaz]

Merhaba Arkadaşlar...

Okul Aşı Uygulamaları kapsamın da kullanacağımız standart OKUL AŞILARI ÖĞRENCİ TAKİP FORMU' na okul şube olarak seçerek kayıtları aktarmak için tüm çalışmalarıma rağmen verileri tam olarak aktarmayı başaramadım.

Ekte yaptığım örnek çalışma ile ilgili yardım ve önerileriniz için şimdiden şükranlarımı sunuyorum.

 

[vardar07]

Kodlarınız normal çalışıyor listeniz yeterli olmadığı için tam test yapamadım. Sadece LİSTELE_Click altındaki kodları aşağıdaki ile değiştirip denermisiniz.

Private Sub LİSTELE_Click()
Dim a, syf As Worksheet
Dim i As Long
Dim j As Integer
Dim Ad As String
Dim Soyad As String
Dim AdSoy As String
Set syf = Sheets("Okul_Listesi")
With Sheets("Okul_Aşı_Takip_Formu")
.Range("M4:M8").ClearContents
.Range("C11:K35").ClearContents
.Range("C51:K75").ClearContents
.Range("C92:K116").ClearContents
.Range("C133:K157").ClearContents

.Range("C6") = Evaluate("=UPPER(""" & ComboBox1.Text & """)")
.Range("J4") = Evaluate("=UPPER(""" & ComboBox2.Text & """)")
say = 0
SON = syf.Cells(Rows.Count, "A").End(3).Row
For x = 2 To SON
If syf.Cells(x, "b") = ComboBox1.Text And syf.Cells(x, "E") = ComboBox2.Text Then
say1 = say1 + 1
End If
Next
.[P1] = say1
bölünecek_sayi = 25
sat1 = bölünecek_sayi
sat = 11
sat2 = 51
sat3 = 92
For i = 2 To SON
If syf.Range("B" & i) = ComboBox1.Text And syf.Range("E" & i) = ComboBox2.Text Then
Ad = ""
Soyad = ""
a = Split(syf.Cells(i, "D"), " ")
For j = 0 To UBound(a) - 1
Ad = Trim(Ad & " " & a(j))
Next j
    
Soyad = Trim(a(UBound(a)))
Ad = Evaluate("=PROPER(""" & Ad & """)")
Soyad = Evaluate("=UPPER(""" & Soyad & """)")
 
If [COLOR="red"].[P1][/COLOR] >= 0 And [COLOR="Red"].[P1][/COLOR] <= 26 Then
.Cells(sat, "C") = syf.Cells(i, "C")
.Cells(sat, "D") = Ad
.Cells(sat, "E") = Soyad
sat = sat + 1
ElseIf [COLOR="red"].[P1][/COLOR] >= 27 And [COLOR="red"].[P1] [/COLOR]<= 51 Then
.Cells(sat2, "C") = syf.Cells(i, "C")
.Cells(sat2, "D") = Ad
.Cells(sat2, "E") = Soyad
sat2 = sat2 + 1
ElseIf [COLOR="Red"].[P1][/COLOR] >= 52 And [COLOR="red"].[P1][/COLOR]<= 117 Then
.Cells(sat3, "C") = syf.Cells(i, "C")
.Cells(sat3, "D") = Ad
.Cells(sat3, "E") = Soyad
sat3 = sat3 + 1
End If
End If
Next i
End With
MsgBox " İşlem Tamamdır..."
End Sub

 

[omeryılmaz]

İlginiz için şükranlarımı sunuyorum...

Problem Deneme1 Ortaokulu 8/A sorgulama dışındakiler ilk sayfadan başlamıyor.

Sorgulamada Deneme2 Ortaokulu şubelerine ait kayıtlarda form1 den Listelenmeye başlaması

 

[fireman64]

Alternatif dosyanız ektedir.

 

[omeryılmaz]

Alternatif dosyanız ektedir.

Şükranlarımı sunuyorum..

 

[fireman64]

Rica ederim

 

[vardar07]

İlginiz için şükranlarımı sunuyorum...

Problem Deneme1 Ortaokulu 8/A sorgulama dışındakiler ilk sayfadan başlamıyor.

Sorgulamada Deneme2 Ortaokulu şubelerine ait kayıtlarda form1 den Listelenmeye başlaması

Gerçi Sayın fireman64 userform ile cevabı sunmuş. Yukarıdaki mesajda bulunan kodda gerekli değişiklik yapıldı.