Dizide farklı bir düzende sıralama

[tamer42]

Merhaba,
Aşağıdaki kodla Diziler içinde bulunan elamanları alfebetik olarak sıralama yapabilmekteyiz?
Benim talebim ise biraz farklı:
1. olarak: Dizi içinde elaman olarak "S" varsa; onu ilk sıraya al,
2. olarak: Dizi içinde elaman olarak "M" varsa; onu ikinci sıraya al, eğer dizi içinde "S" yoksa doğal olarak "M" ilk sıraya gelecek
önceden belirlenmiş bu iki harften ("S" ve "M") sonra kalan diğer elamanları normal alfabetik olarak sıralamayı nasıl yabiliriz?

Örnek olarak aşağıdaki dizi : Array("S", "M", "L", "XL", "XXL", "XXL") şeklinde dizilecek.

özetle: eğer mevcutsa ("S" ve "M") ilk sıralara yerleşek, ondan sonrası alfabetik olması gereken gibi olacak.

ilginiz için şimdiden teşekkürler;
iyi Çalışmalar.

Sub Test123()
Dim Array_2, arr

Array_2 = Array("M", "L", "S", "XL", "XXL", "XXL")

arr = SortArrayAZ(Array_2)

End Sub
[/code]

Function SortArrayAZ(myArray As Variant)

Dim i As Long
Dim j As Long
Dim Temp

'Sort the Array A-Z
For i = LBound(myArray) To UBound(myArray) - 1
    For j = i + 1 To UBound(myArray)
        If UCase(myArray(i)) > UCase(myArray(j)) Then
            Temp = myArray(j)
            myArray(j) = myArray(i)
            myArray(i) = Temp
        End If
    Next j
Next i

SortArrayAZ = myArray

End Function

 

[veyselemre]

Function SortArrayAZ(myArray As Variant)

    Dim bedenler, beden, tmp
    bedenler = Split("XXS,XS,S,M,L,XL,XXL,3XL,4XL,5XL", ",")

    For Each beden In bedenler
        If Not IsError(Application.Match(beden, myArray, 0)) Then
            tmp = tmp & "," & beden
        End If
    Next
    SortArrayAZ = Split(Mid(tmp, 2), ",")

End Function

 

[tamer42]

,S,M,L,XL,XXL,3XL,4XL,5XL", ",")

Function SortArrayAZ(myArray As Variant)

    Dim bedenler, beden, tmp
    bedenler = Split("XXS,XS,S,M,L,XL,XXL,3XL,4XL,5XL", ",")

    For Each beden In bedenler
        If Not IsError(Application.Match(beden, myArray, 0)) Then
            tmp = tmp & "," & beden
        End If
    Next
    SortArrayAZ = Split(Mid(tmp, 2), ",")

End Function

çok teşekkürler Veysel Hocam,
iyiki varsınız!

 

[tamer42]

çok teşekkürler Veysel Hocam,
iyiki varsınız!

Function SortArrayAZ(myArray As Variant)

    Dim bedenler, beden, tmp
    bedenler = Split("XXS,XS,S,M,L,XL,XXL,3XL,4XL,5XL", ",")

    For Each beden In bedenler
        If Not IsError(Application.Match(beden, myArray, 0)) Then
            tmp = tmp & "," & beden
        End If
    Next
    SortArrayAZ = Split(Mid(tmp, 2), ",")

End Function

Veysel Hocam burada şöyle bir sorunumuz var,
bedenler = Split("XXS,XS,S,M,L,XL,XXL,3XL,4XL,5XL", ",")
bu beden listesinde olmayan bir beden ortaya çıktığında; hiç bir şey olmamış gibi onları dizinin sonuna doğru alpabetik olarak eklenmesi sağlanabilir mi?
çünkü bazen hiç beklenmedik değerler önümüze çıkabiliyor, "S-M", "8-10 yaş" yada "10-12 yaş" gibi...
onları dizinin sonuna eklesin

tekrar teşekkürler,
iyi akşamlar.

 

[veyselemre]

Function SortArrayAZ(myArray As Variant)

    Dim bedenler, beden, tmp, i
    bedenler = Split("XXS,XS,S,M,L,XL,XXL,3XL,4XL,5XL", ",")
    
    With CreateObject("Scripting.Dictionary")
    
        For Each beden In myArray
            .Item(beden) = Null
        Next beden
    
        For i = LBound(bedenler) To UBound(bedenler)
            If .exists(bedenler(i)) Then
                tmp = tmp & "," & bedenler(i)
               .Remove (bedenler(i))
            End If
        Next
 
        If .Count > 0 Then tmp = tmp & "," & Join(.keys, ",")
        
        SortArrayAZ = Split(Mid(tmp, 2), ",")
    
    End With

End Function

 

[tamer42]

Function SortArrayAZ(myArray As Variant)

    Dim bedenler, beden, tmp, i
    bedenler = Split("XXS,XS,S,M,L,XL,XXL,3XL,4XL,5XL", ",")
   
    With CreateObject("Scripting.Dictionary")
   
        For Each beden In myArray
            .Item(beden) = Null
        Next beden
   
        For i = LBound(bedenler) To UBound(bedenler)
            If .exists(bedenler(i)) Then
                tmp = tmp & "," & bedenler(i)
               .Remove (bedenler(i))
            End If
        Next

        If .Count > 0 Then tmp = tmp & "," & Join(.keys, ",")
       
        SortArrayAZ = Split(Mid(tmp, 2), ",")
   
    End With

End Function

Çok teşekkür ederim Veysel Hocam