option buton hakkında

[alperen37]

ekteki dosyada arama kısmında option butonlarından ortalaması ( 0-1-2-3-4-5) olan öğrencileri 1.dönem ortalamaya göre buldurup sıralatabiliyorum.fakat 2.dönem ortalama ve yıl sonu ortalamada var.bunlardan hangisine göre sıralama yapmak istediğimizi combobox yardımıyla seçip bunlara görede yapmak istiyorum ama bu durumda kodlar bayağı uzayacak (tabi benim kısıtlı vba bilgilerimle)çünkü option butonda 5 seçenek ve her bir seçenek için 3 durum olacak .herbiri için ayrı kodmu yazmalıyım.gerçi her durum için kodlar çoğu kez aynı sadece sıralatacağı sutun değişiyor. bir alt proğram yazarak devamlı onumu çağırmalı ama bu konuyu bilmiyorum.inşallah derdimi anlatabildim.ustalarım dosyayı incelerse belki yardımınız dokunabilir.teşekkürler

 

[alperen37]

cevap verebilecek yokmu

 

[Levent Menteşoğlu]

Dosyanızdaki listele butonunda yazan kodlar yerine aşağıdakini kopyalayarak deneyin. Üzerinde biraz daha düşünülürse daha da kısaltılabilir.

Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
Set s1 = Sheets("arama")
Set s2 = Sheets("liste")
s1.Range("B4:V400").ClearContents
Select Case s1.ComboBox2.Value
Case "1.D": sut = 11
Case "2.D": sut = 20
Case "YIL SONU": sut = 22
End Select
For a = 1 To 6
If s1.Shapes("optionbutton" & a).OLEFormat.Object.Object.Value = True Then
Select Case a
Case 1: deg1 = 0: deg2 = 24.5
Case 2: deg1 = 24.4: deg2 = 44.5
Case 3: deg1 = 44.4: deg2 = 54.5
Case 4: deg1 = 54.4: deg2 = 69.5
Case 5: deg1 = 69.4: deg2 = 84.5
Case 6: deg1 = 84.4: deg2 = 101
End Select
Exit For
End If
Next
For b = 4 To s2.[b65536].End(3).Row
If s2.Cells(b, sut) = 0 Then Exit For
If s2.Cells(b, sut) > deg1 And s2.Cells(b, sut) < deg2 Then
c = c + 1
For d = 2 To 22
s1.Cells(c + 3, d) = s2.Cells(b, d)
Next
End If
Next
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
s1.Range("B4:V400").Sort Key1:=s1.Cells(4, sut), Order1:=xlDescending, Key2:=s1.Range("C4") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
End Sub

 

[alperen37]

teşekkürler yıl sonunda bi problem var sanırım ama halledebilirim ilginize teşekkürler.