2 boyutlu Dizi içinde sıralama

[tamer42]

Merhaba,
Tek boyutlu dizide sıralama yapabiliyoruz, yalnız bunun iki boyulu olması durumda nasıl yapabileceğimize dair bir bilgi bulamadım

Ekli dosyada "C" sütunda tarih, "D" sütununda ise bu tarihlerdeki satış tutarları mevcut,

Burada tarih ve satışları aynı anda dizi içine aldıktan sonra; Diziyi Tarihlere göre küçükten büyüğe nasıl sıralayabilirz?

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

Sub tBonus()
Dim WS As Worksheet

Dim LR As Long, i As Long
Dim Quarter As Integer
Dim inDate As String
Dim x As Long, y As Long

pers = "pers-1"

Set dict = New Scripting.Dictionary


Set WS = Sayfa1

LR = WS.Range("A" & WS.Rows.Count).End(xlUp).Row

x = 1

y = Application.WorksheetFunction.CountIf(WS.Range("B2:B" & LR), pers)

ReDim arr(1 To y, 1 To 2)

For i = 2 To LR

    If WS.Range("C" & i) <> "" And WS.Range("B" & i) = pers Then
        inDate = WS.Range("C" & i)
        Quarter = DatePart("q", inDate)
        
            
              '''  dict.Add inDate, WS.Range("D" & i)
               
                arr(x, 1) = inDate
                arr(x, 2) = WS.Range("D" & i)
                x = x + 1

    End If

Next i


End Sub

[end sub]

 

[tamer42]

Merhaba,
Tek boyutlu dizide sıralama yapabiliyoruz, yalnız bunun iki boyulu olması durumda nasıl yapabileceğimize dair bir bilgi bulamadım

Ekli dosyada "C" sütunda tarih, "D" sütununda ise bu tarihlerdeki satış tutarları mevcut,

Burada tarih ve satışları aynı anda dizi içine aldıktan sonra; Diziyi Tarihlere göre küçükten büyüğe nasıl sıralayabilirz?

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

merhaba,
2 boyutlu dizide sıralama konusunda aşağıdaki kodu buldum,
https://stackoverflow.com/questions/4873182/sorting-a-multidimensionnal-array-in-vba
Yalnız bu büyükten küçüğe doğru sıralama yapıyor,
küçükten büyüğe sıralama için nasıl bir düzeltme yapılabilir?

Sub test()

    Dim TestArray1(1 To 4, 0 To 1) As Variant
    Dim TestArray2() As Variant
    

    TestArray1(1, 0) = 108
    TestArray1(2, 0) = 109
    TestArray1(3, 0) = 106
    TestArray1(4, 0) = 110

    TestArray1(1, 1) = 10
    TestArray1(2, 1) = 5
    TestArray1(3, 1) = 15
    TestArray1(4, 1) = 2

    TestArray2 = TestArray1
    Call QuickSortArray(TestArray2, , , 1)

    Debug.Print TestArray2(1, 1)

End Sub

Public Sub QuickSortArray(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1, Optional lngColumn As Long = 0)
   '' On Error Resume Next

    Dim i As Long
    Dim j As Long
    Dim varMid As Variant
    Dim arrRowTemp As Variant
    Dim lngColTemp As Long

    If IsEmpty(SortArray) Then
        Exit Sub
    End If
    
    If InStr(TypeName(SortArray), "()") < 1 Then  'IsArray() is somewhat broken: Look for brackets in the type name
        Exit Sub
    End If
    If lngMin = -1 Then
        lngMin = LBound(SortArray, 1)
    End If
    If lngMax = -1 Then
        lngMax = UBound(SortArray, 1)
    End If
    If lngMin >= lngMax Then    ' no sorting required
        Exit Sub
    End If

    i = lngMin
    j = lngMax

    varMid = Empty
    varMid = SortArray((lngMin + lngMax) \ 2, lngColumn)

    ' We  send 'Empty' and invalid data items to the end of the list:
    If IsObject(varMid) Then  ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a valid default member or property
        i = lngMax
        j = lngMin
    ElseIf IsEmpty(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf IsNull(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf varMid = "" Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) = vbError Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) > 17 Then
        i = lngMax
        j = lngMin
    End If

    While i <= j
        While SortArray(i, lngColumn) < varMid And i < lngMax
            i = i + 1
        Wend
        While varMid < SortArray(j, lngColumn) And j > lngMin
            j = j - 1
        Wend

        If i <= j Then
            ' Swap the rows
            ReDim arrRowTemp(LBound(SortArray, 2) To UBound(SortArray, 2))
            For lngColTemp = LBound(SortArray, 2) To UBound(SortArray, 2)
                arrRowTemp(lngColTemp) = SortArray(i, lngColTemp)
                SortArray(i, lngColTemp) = SortArray(j, lngColTemp)
                SortArray(j, lngColTemp) = arrRowTemp(lngColTemp)
            Next lngColTemp
            Erase arrRowTemp

            i = i + 1
            j = j - 1
        End If
    Wend

    If (lngMin < j) Then Call QuickSortArray(SortArray, lngMin, j, lngColumn)
    If (i < lngMax) Then Call QuickSortArray(SortArray, i, lngMax, lngColumn)

End Sub

 

[Korhan Ayhan]

Merhaba,

Bence ADO ile veriyi sorgu yardımıyla sıraladıktan sonra diziye alabilirsiniz.