Ã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:
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: