Belli Aralıkta sıralama

[tamer42]

Merhaba,

Range("B15:I27") aralığında veri yapısını , I ve F sütununa göre sıralatmak istiyordum.

Aşağıdaki kodda hata hata vermektedir, nasıl düzenleyebiliriz?

Teşekkürler,
iyi akşamlar.

Sub SortMultipleColumns()

Dim WS As Worksheet: Set WS = ThisWorkbook.Worksheets("Sheet1")

WS.Activate

    With WS
        With .Cells(15, "B").CurrentRegion
            .Cells.Sort Key1:=.Range("I15"), Order1:=xlAscending, _
                        Key2:=.Range("F15"), Order2:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlYes
        End With
    End With

End Sub

 

[Greenblacksea53]

Sub SortData()
    ' Veri yapısının olduğu aralığı tanımlayın
    Dim dataRange As Range
    Set dataRange = Range("B15:I27")
    
    ' Sıralama türünü belirleyin (artan veya azalan)
    Dim sortType As XlSortOrder
    sortType = xlDescending ' xlAscending kullanarak artan sıralama yapabilirsiniz
    
    ' Sıralama yapın
    dataRange.Sort Key1:=Range("I15:I27"), Order1:=sortType, Key2:=Range("F15:F27"), Order2:=sortType, Header:=xlNo, Orientation:=xlTopToBottom
End Sub

Denermisin ?

 

[tamer42]

Sub SortData()
    ' Veri yapısının olduğu aralığı tanımlayın
    Dim dataRange As Range
    Set dataRange = Range("B15:I27")
  
    ' Sıralama türünü belirleyin (artan veya azalan)
    Dim sortType As XlSortOrder
    sortType = xlDescending ' xlAscending kullanarak artan sıralama yapabilirsiniz
  
    ' Sıralama yapın
    dataRange.Sort Key1:=Range("I15:I27"), Order1:=sortType, Key2:=Range("F15:F27"), Order2:=sortType, Header:=xlNo, Orientation:=xlTopToBottom
End Sub

Denermisin ?

Çok teşekkür ederim,
emeğinize sağlık;

Olayı bir aşama daha ileriye taşımak istiyorum.

Ekli dosyada;
Sheet1 içinde I sütununda Aciliyet sıralaması yaparken , bu sütun içinde yazılı olan metinsel ifadeleri değilde ; Sheet2 de D:E sutun aralığında bu metinin karşılığındaki puanı esas alarak sıralama nasıl yapabilir?

Örnek :
Düşük değeri için 1' i
Orta değeri için 2' yi
Yüksek değeri için 3' i

esas alarak nümerik değere göre sıralama yapacak bir yönten arayışındayım.

ilgi ve alakanız için tekrar teşekkürler,
iyi Haftasonları.

 

[RBozkurt]

B sütunu referans alır. I'da yazan veriye göre L'ye referans atar. Sıralamayı yapar ve L'yi temizler.

Option Explicit

Sub SortData()
    Dim lastRow As Long
    lastRow = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
   
    Dim i As Long
    For i = 16 To lastRow
        Select Case Sheet1.Range("I" & i).Value
            Case "Yüksek"
                Sheet1.Range("L" & i).Value = 3
            Case "Orta"
                Sheet1.Range("L" & i).Value = 2
            Case "Düşük"
                Sheet1.Range("L" & i).Value = 1
            Case "Orta Altı"
                Sheet1.Range("L" & i).Value = 4
            Case "Orta Üstü"
                Sheet1.Range("L" & i).Value = 5
        End Select
    Next i
   
    Sheet1.Range("B16:L" & lastRow).Sort key1:=Sheet1.Range("L16:L" & lastRow), order1:=xlDescending, Header:=xlNo
    Sheet1.Range("L16:L" & lastRow).ClearContents
End Sub

 

[veyselemre]

Sub Macro4()
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("I16:I29") _
                             , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
                        "Düşük,Orta Altı,Orta,Yüksek", DataOption:=xlSortNormal
        .SetRange Range("B15:J29")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[tamer42]

B sütunu referans alır. I'da yazan veriye göre L'ye referans atar. Sıralamayı yapar ve L'yi temizler.

Option Explicit

Sub SortData()
    Dim lastRow As Long
    lastRow = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
  
    Dim i As Long
    For i = 16 To lastRow
        Select Case Sheet1.Range("I" & i).Value
            Case "Yüksek"
                Sheet1.Range("L" & i).Value = 3
            Case "Orta"
                Sheet1.Range("L" & i).Value = 2
            Case "Düşük"
                Sheet1.Range("L" & i).Value = 1
            Case "Orta Altı"
                Sheet1.Range("L" & i).Value = 4
            Case "Orta Üstü"
                Sheet1.Range("L" & i).Value = 5
        End Select
    Next i
  
    Sheet1.Range("B16:L" & lastRow).Sort key1:=Sheet1.Range("L16:L" & lastRow), order1:=xlDescending, Header:=xlNo
    Sheet1.Range("L16:L" & lastRow).ClearContents
End Sub

teşekkürler,

 

[tamer42]

Sub Macro4()
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("I16:I29") _
                             , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
                        "Düşük,Orta Altı,Orta,Yüksek", DataOption:=xlSortNormal
        .SetRange Range("B15:J29")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Veysel Hocam teşekkürler

CustomOrder:= _
                        "Düşük,Orta Altı,Orta,Yüksek"

buradaki değerleri tek-tek yazmak yerine;
Ekli ekran görüntüsünde olduğu gibi "Aciliyet" adındaki bir tanımlanmış ad içine ekleyerek, nasıl düzenleyebiliriz?

=OFFSET(Sheet2!$D$6,,,5,1)
özetle liste olarak kaydetmenin yada başka pratik bir yöntemi var mıdır?

tekrar teşekkürler,
iyi Çalışmalar.

 

[tamer42]

Veysel Hocam teşekkürler

CustomOrder:= _
                        "Düşük,Orta Altı,Orta,Yüksek"

buradaki değerleri tek-tek yazmak yerine;
Ekli ekran görüntüsünde olduğu gibi "Aciliyet" adındaki bir tanımlanmış ad içine ekleyerek, nasıl düzenleyebiliriz?

=OFFSET(Sheet2!$D$6,,,5,1)
özetle liste olarak kaydetmenin yada başka pratik bir yöntemi var mıdır?

tekrar teşekkürler,
iyi Çalışmalar.

Ekte olduğu gibi bir çözüm üretmeye çalıştım ama hata verdi,
Neden Kaynaklanıyor olabilir anlamaadım

 sSortOrder = "Çok Düşük,Düşük,Orta,Yüksek,Çok Yüksek"
 
  ''sSortOrder = CStr(Join(vCustom_Sort, ","))

    With ActiveWorkbook.Worksheets("Sheet1").Sort
    
        .SortFields.Clear
        
        .SortFields.Add Key:=Range("I16:I29") _
                             , SortOn:=xlSortOnValues, Order:=xlDescending, CustomOrder:= _
                        sSortOrder, DataOption:=xlSortNormal
                      
        .SetRange Range("B15:J29")
        
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        
    End With

 

[veyselemre]

    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("I16:I29"), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, _
                        CustomOrder:=Join(Application.Transpose(Range("Aciliyet").Value), ",")
        .SetRange Range("B15:J29")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

 

[tamer42]

    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("I16:I29"), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, _
                        CustomOrder:=Join(Application.Transpose(Range("Aciliyet").Value), ",")
        .SetRange Range("B15:J29")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Veysel Hocam çok teşekkürler,
iyi ki varsınız

çok önemli olmasa da bir şey daha soracağım
Aşağıdaki gibi denemeye çalışınca hata verdi,

dediğim gibi çok önemli değil;

tekrar teşekkürler,

Dim StrOrder
strOrder = Join(Application.Transpose(Range("Aciliyet").Value), ",")

    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("I16:I29"), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, _
                        CustomOrder:=strOrder

 

[veyselemre]

    Dim strOrder
    strOrder = Join(Application.Transpose(Range("Aciliyet").Value), ",")

    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("I16:I29"), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, _
                        CustomOrder:=CVar(strOrder)
        .SetRange Range("B15:J29")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With