İki Koşullu Süzme

[muallim]

Ýki Koşullu Süzme

Saygıdeğer Excelciler
Buyurun size yorgunluğunuzu giderecek basit üç soru.
1) Bu kodlarla “ANA” isimli sayfadan “ALİ” isimli öğrencileri süzüp (B,D,F) sütunlarındaki bilgilerini Sayfa1’e kopyalıyorum. “ANA” sayfada Hem adı “ALİ” hem de Okulu “LİSE” olanları süzüp Sayfa1’e kopyalayabilir miyim?
Sub MakroAdı1()
Sheets("Sayfa1").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Sheets("ANA").Select
Selection.AutoFilter Field:=2, Criteria1:="ALİ"
Range("B:B,D: D,F:F").Select
Selection.Copy
Sheets("Sayfa1").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("ANA").Select
Selection.AutoFilter Field:=2
Range("A2").Select
Application.CutCopyMode = False
Sheets("Sayfa1").Select
Range("A2").Select
Columns("A:G").EntireColumn.AutoFit
End Sub
----------------------------------------------
2) Aşağıdaki kodlarla (B2:F2) aralığının ortalaması (g2)>= 4 ise “TAKDİR”, 3,5 ise “TEÞEKKÜR” yazıyor.
Ancak (B2:F2) hücrelerinde “1,5” tan daha küçük değer olduğunda bu işlemi yapmamalı.(H2) boş görülmeli.
Sub teştak()
Range("g2") = WorksheetFunction.Average(Range("b2:f2"))
If Range("g2") >= 4 Then
Range("h2") = "TAKDİR"
ElseIf Range("g2") >= 3.5 Then
Range("h2") = "TEÞEKKÜR"
Else: Range("H2") = ""
End If
End Sub
---------------------------------------------------------------------
3) Aşağıdaki kodlarla da (B2:F2)hücrelerinin ortalamasını (G2) ye alıp (H2) ye beşlik sistemde yazıyorum. Ancak (B2:F2) hücrelerinde bir değer olmak zorunda. Hiçbir değer olmadan ortalama almak istediğimde "Microsoft Visual Basic 400” uyarısını almak istemiyorum. Bunun yerine msgbox ta “En az bir not girmelisiniz” gibi bir uyarı versin. Ve örneğin UserFormum kapansın.

Sub ortalama()
Range("g2") = WorksheetFunction.Average(Range("b2:f2"))
If Range("g2") > 84 Then
Range("h2") = 5
ElseIf Range("g2") > 69 Then
Range("h2") = 4
ElseIf Range("g2") > 54 Then
Range("h2") = 3
ElseIf Range("g2") > 44 Then
Range("h2") = 2
ElseIf Range("g2") > 25 Then
Range("h2") = 1
Else: Range("h2") = 0
End If
End Sub

--------------------------------------------------------------------------
Dosya ektedir. :hey:

 

[muallim]

Re: Ýki Koşullu Süzme

ww

 

[Levent Menteşoğlu]

1-Süzme kriteri olarak bir tane daha ilave edin.

Selection.AutoFilter Field:=2, Criteria1:="ALİ"
Selection.AutoFilter Field:=4, Criteria1:="LİSE"

2-Kodunuza aşağıdaki mavi renkli ilaveleri yapın.

[vb:1:d1e4d26c9e]Sub ortalama()
On Error GoTo 10
Range("g2") = WorksheetFunction.Average(Range("b2:f2"))
If Range("g2") > 84 Then
Range("h2") = 5
ElseIf Range("g2") > 69 Then
Range("h2") = 4
ElseIf Range("g2") > 54 Then
Range("h2") = 3
ElseIf Range("g2") > 44 Then
Range("h2") = 2
ElseIf Range("g2") > 25 Then
Range("h2") = 1
Else: Range("h2") = 0
End If
Exit Sub
10 MsgBox "en az bir değer girmelisiniz"
End Sub
[/vb:1:d1e4d26c9e]

 

[muallim]

Leventm teşekkürler, bir de şunun cevabını alabilseydim! İyi Ramazanlar...
2) Aşağıdaki kodlarla (B2:F2) aralığının ortalaması (g2)>= 4 ise “TAKDİR”, 3,5 ise “TEÞEKKÜR” yazıyor.
Ancak (B2:F2) hücrelerinde “1,5” tan daha küçük değer olduğunda bu işlemi yapmamalı.(H2) boş görülmeli.
Sub teştak()
Range("g2") = WorksheetFunction.Average(Range("b2:f2"))
If Range("g2") >= 4 Then
Range("h2") = "TAKDİR"
ElseIf Range("g2") >= 3.5 Then
Range("h2") = "TEÞEKKÜR"
Else: Range("H2") = ""
End If
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

[vb:1:51cbba3008]Sub teştak()
If WorksheetFunction.Min([b2:f2]) < 1.5 Then Exit Sub
Range("g4") = WorksheetFunction.Average(Range("b4:f4"))
If Range("g4") >= 4 Then
Range("h4") = "TAKDİR"
ElseIf Range("g4") >= 3.5 Then
Range("h4") = "TEÞEKKÜR"
Else: Range("H4") = ""
End If
End Sub[/vb:1:51cbba3008]

 

[muallim]

Sayın leventm, kodlarla isteğime ulaşamadım. Biliyorum ki elinizden kurtulmaz. B4:F4 aralığındaki hücrelerde 1 olunca yine takdir/teşekkür yazıyor. Selamlar... :hey: b2:f2 ler 4 olacak.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:1b5c000cc6]Sub teştak()
If WorksheetFunction.Min([b4:f4]) < 1.5 Then
Range("h4") = ""
Exit Sub
End If
Range("g4") = WorksheetFunction.Average(Range("b4:f4"))
If Range("g4") >= 4 Then
Range("h4") = "TAKDİR"
ElseIf Range("g4") >= 3.5 Then
Range("h4") = "TEÞEKKÜR"
Else: Range("H4") = ""
End If
End Sub[/vb:1:1b5c000cc6]

 

[muallim]

Teşekkürler leventm. Elinize sağlık. :mutlu: