Xếp theo thứ tự từ ngày lớn nhất đến ngày bé nhất trong Mảng

[Yeuvoyeucon]

Kính gửi anh chị
Đoạn code dưới em lọc thông tin và kết quả ra tại Arr1(a1, 6) = Arr(i, 10) là cột ngày tháng năm. Giờ thêm code thế nào để nó xếp kết quả của mảng 8 cột này theo cột 6 có ngày giảm dần (Từ ngày lớn nhất/gần nhất đến ngày nhỏ nhất). Em cảm ơn ạ.

Sub Loc()
    Dim Arr, Arr1, Arr2, i As Long, lr As Long, a1 As Long, DK As Long
    With Sheet1
         lr = .Range("A" & Rows.count).End(xlUp).Row
         Arr = .Range("B2:N" & lr).Value
         ReDim Arr1(1 To UBound(Arr, 1), 1 To 8)
    End With
    With Sheet2
         DK = .Range("A1").Value2
         For i = 1 To UBound(Arr)
             If CLng(Arr(i, 1)) = DK Then
                a1 = a1 + 1
                Arr1(a1, 1) = Arr(i, 1)
                Arr1(a1, 2) = Arr(i, 2)
                Arr1(a1, 3) = Arr(i, 5)
                Arr1(a1, 4) = Arr(i, 7)
                Arr1(a1, 5) = Arr(i, 8)
                Arr1(a1, 6) = Arr(i, 10)
                Arr1(a1, 7) = Arr(i, 12)
                Arr1(a1, 8) = Arr(i, 13)
                End If
      Next i
.Range("a6:L9000").ClearContents
If a1 Then .Range("A6").Resize(a1, 8).Value = Arr1
   End With
End Sub

 

[vanthinh3101]

Kính gửi anh chị
Đoạn code dưới em lọc thông tin và kết quả ra tại Arr1(a1, 6) = Arr(i, 10) là cột ngày tháng năm. Giờ thêm code thế nào để nó xếp kết quả của mảng 8 cột này theo cột 6 có ngày giảm dần (Từ ngày lớn nhất/gần nhất đến ngày nhỏ nhất). Em cảm ơn ạ.

Sub Loc()
    Dim Arr, Arr1, Arr2, i As Long, lr As Long, a1 As Long, DK As Long
    With Sheet1
         lr = .Range("A" & Rows.count).End(xlUp).Row
         Arr = .Range("B2:N" & lr).Value
         ReDim Arr1(1 To UBound(Arr, 1), 1 To 8)
    End With
    With Sheet2
         DK = .Range("A1").Value2
         For i = 1 To UBound(Arr)
             If CLng(Arr(i, 1)) = DK Then
                a1 = a1 + 1
                Arr1(a1, 1) = Arr(i, 1)
                Arr1(a1, 2) = Arr(i, 2)
                Arr1(a1, 3) = Arr(i, 5)
                Arr1(a1, 4) = Arr(i, 7)
                Arr1(a1, 5) = Arr(i, 8)
                Arr1(a1, 6) = Arr(i, 10)
                Arr1(a1, 7) = Arr(i, 12)
                Arr1(a1, 8) = Arr(i, 13)
                End If
      Next i
.Range("a6:L9000").ClearContents
If a1 Then .Range("A6").Resize(a1, 8).Value = Arr1
   End With
End Sub

Điền kết quả ra sheet rồi Sort được không bạn?
Code Sort thì bạn Record Macro rồi sửa đi 1 chút là được.

 

[HUONGHCKT]

Kính gửi anh chị
Đoạn code dưới em lọc thông tin và kết quả ra tại Arr1(a1, 6) = Arr(i, 10) là cột ngày tháng năm. Giờ thêm code thế nào để nó xếp kết quả của mảng 8 cột này theo cột 6 có ngày giảm dần (Từ ngày lớn nhất/gần nhất đến ngày nhỏ nhất). Em cảm ơn ạ.

Sub Loc()
    Dim Arr, Arr1, Arr2, i As Long, lr As Long, a1 As Long, DK As Long
    With Sheet1
         lr = .Range("A" & Rows.count).End(xlUp).Row
         Arr = .Range("B2:N" & lr).Value
         ReDim Arr1(1 To UBound(Arr, 1), 1 To 8)
    End With
    With Sheet2
         DK = .Range("A1").Value2
         For i = 1 To UBound(Arr)
             If CLng(Arr(i, 1)) = DK Then
                a1 = a1 + 1
                Arr1(a1, 1) = Arr(i, 1)
                Arr1(a1, 2) = Arr(i, 2)
                Arr1(a1, 3) = Arr(i, 5)
                Arr1(a1, 4) = Arr(i, 7)
                Arr1(a1, 5) = Arr(i, 8)
                Arr1(a1, 6) = Arr(i, 10)
                Arr1(a1, 7) = Arr(i, 12)
                Arr1(a1, 8) = Arr(i, 13)
                End If
      Next i
.Range("a6:L9000").ClearContents
If a1 Then .Range("A6").Resize(a1, 8).Value = Arr1
   End With
End Sub

Theo tôi bạn muốn xử lý bài này thì:
1/ sarch bài Sort2Darray trong đó có code sắp xếp mảng 1 chiều, 2 chiều (theo nhiều tiêu chí sắp xếp) của anh NDU
2/Gán xuống Sh và sort (ghi lại macro) sửa lại là được.
Tôi gửi bạn một đoạn Code (ghi lại macro-sửa lại của 1 bài Tính toán doanh số bán hàng mà tôi đã có dịp làm giúp bạn).
Trong đó dòng tiêu đề là có sẵn và nằm trên dòng kết quả.

........
If t Then
    .[H15].Resize(1000, 9).ClearContents
    .[H15].Resize(t, 9) = KQ
End If
Set Rng = .[I14].Resize(t + 1, 8)
    R = Rng.Find("Doanh s?").Row            ' tìm cột doanh số trong vùng tiêu đề
    C = Rng.Find("Doanh s?").Column
    ActiveWorkbook.Worksheets("Doanh_so").Sort.SortFields.Add Key:=Range(.Cells(R + 1, C), Cells(R + 1 + t, C)) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal                                                                                      ' Range(.Cells(R + 1, C), Cells(R + 1 + t, C)) : la vung điều kiện
    With ActiveWorkbook.Worksheets("Doanh_so").Sort
        .SetRange Rng                                                                                   ' sắp xếp vùng đã chọn theo ĐK và cách sắp xếp
        .Header = xlYes
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
.........

 

[snow25]

Kính gửi anh chị
Đoạn code dưới em lọc thông tin và kết quả ra tại Arr1(a1, 6) = Arr(i, 10) là cột ngày tháng năm. Giờ thêm code thế nào để nó xếp kết quả của mảng 8 cột này theo cột 6 có ngày giảm dần (Từ ngày lớn nhất/gần nhất đến ngày nhỏ nhất). Em cảm ơn ạ.

Sub Loc()
    Dim Arr, Arr1, Arr2, i As Long, lr As Long, a1 As Long, DK As Long
    With Sheet1
         lr = .Range("A" & Rows.count).End(xlUp).Row
         Arr = .Range("B2:N" & lr).Value
         ReDim Arr1(1 To UBound(Arr, 1), 1 To 8)
    End With
    With Sheet2
         DK = .Range("A1").Value2
         For i = 1 To UBound(Arr)
             If CLng(Arr(i, 1)) = DK Then
                a1 = a1 + 1
                Arr1(a1, 1) = Arr(i, 1)
                Arr1(a1, 2) = Arr(i, 2)
                Arr1(a1, 3) = Arr(i, 5)
                Arr1(a1, 4) = Arr(i, 7)
                Arr1(a1, 5) = Arr(i, 8)
                Arr1(a1, 6) = Arr(i, 10)
                Arr1(a1, 7) = Arr(i, 12)
                Arr1(a1, 8) = Arr(i, 13)
                End If
      Next i
.Range("a6:L9000").ClearContents
If a1 Then .Range("A6").Resize(a1, 8).Value = Arr1
   End With
End Sub

Máy bạn có cài cái này không.
.NET Framework nếu cài tôi viết code sort theo SortedList.

 

[Yeuvoyeucon]

Theo tôi bạn muốn xử lý bài này thì:
1/ sarch bài Sort2Darray trong đó có code sắp xếp mảng 1 chiều, 2 chiều (theo nhiều tiêu chí sắp xếp) của anh NDU
2/Gán xuống Sh và sort (ghi lại macro) sửa lại là được.
Tôi gửi bạn một đoạn Code (ghi lại macro-sửa lại của 1 bài Tính toán doanh số bán hàng mà tôi đã có dịp làm giúp bạn).
Trong đó dòng tiêu đề là có sẵn và nằm trên dòng kết quả.

........
If t Then
    .[H15].Resize(1000, 9).ClearContents
    .[H15].Resize(t, 9) = KQ
End If
Set Rng = .[I14].Resize(t + 1, 8)
    R = Rng.Find("Doanh s?").Row            ' tìm cột doanh số trong vùng tiêu đề
    C = Rng.Find("Doanh s?").Column
    ActiveWorkbook.Worksheets("Doanh_so").Sort.SortFields.Add Key:=Range(.Cells(R + 1, C), Cells(R + 1 + t, C)) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal                                                                                      ' Range(.Cells(R + 1, C), Cells(R + 1 + t, C)) : la vung điều kiện
    With ActiveWorkbook.Worksheets("Doanh_so").Sort
        .SetRange Rng                                                                                   ' sắp xếp vùng đã chọn theo ĐK và cách sắp xếp
        .Header = xlYes
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
.........

Dạ, để em tham khảo và làm tiếp ạ !

Bài đã được tự động gộp: 8/9/21

Máy bạn có cài cái này không.
.NET Framework nếu cài tôi viết code sort theo SortedList.

Em mò theo code anh Hương hướng dẫn được rùi ạ ! Em cảm ơn anh.

 

[Cá ngừ F1]

Bạn cần Sort theo mấy trường (cột), nếu <=3 cột thì code Sort có 1 dòng à.

 

[Maika8008]

Kính gửi anh chị
Đoạn code dưới em lọc thông tin và kết quả ra tại Arr1(a1, 6) = Arr(i, 10) là cột ngày tháng năm. Giờ thêm code thế nào để nó xếp kết quả của mảng 8 cột này theo cột 6 có ngày giảm dần (Từ ngày lớn nhất/gần nhất đến ngày nhỏ nhất). Em cảm ơn ạ.

Sub Loc()
    Dim Arr, Arr1, Arr2, i As Long, lr As Long, a1 As Long, DK As Long
    With Sheet1
         lr = .Range("A" & Rows.count).End(xlUp).Row
         Arr = .Range("B2:N" & lr).Value
         ReDim Arr1(1 To UBound(Arr, 1), 1 To 8)
    End With
    With Sheet2
         DK = .Range("A1").Value2
         For i = 1 To UBound(Arr)
             If CLng(Arr(i, 1)) = DK Then
                a1 = a1 + 1
                Arr1(a1, 1) = Arr(i, 1)
                Arr1(a1, 2) = Arr(i, 2)
                Arr1(a1, 3) = Arr(i, 5)
                Arr1(a1, 4) = Arr(i, 7)
                Arr1(a1, 5) = Arr(i, 8)
                Arr1(a1, 6) = Arr(i, 10)
                Arr1(a1, 7) = Arr(i, 12)
                Arr1(a1, 8) = Arr(i, 13)
                End If
      Next i
.Range("a6:L9000").ClearContents
If a1 Then .Range("A6").Resize(a1, 8).Value = Arr1
   End With
End Sub

Thay dòng này: If a1 Then .Range("A6").Resize(a1, 8).Value = Arr1

Bằng:
If a1 Then
.Range("A6").Resize(a1, 8).Value = Arr1
.Range("A6").Resize(a1, 8).Sort Key1:=.Cells(6, 6), Order1:=xlDescending, Header:=xlNo
End If

 

[Yeuvoyeucon]

Thay dòng này: If a1 Then .Range("A6").Resize(a1, 8).Value = Arr1

Bằng:
If a1 Then
.Range("A6").Resize(a1, 8).Value = Arr1
.Range("A6").Resize(a1, 8).Sort Key1:=.Cells(6, 6), Order1:=xlDescending, Header:=xlNo
End If

Chuẩn quá anh ơi ! Em cảm ơn anh.