Xếp theo thứ tự từ ngày lớn nhất đến ngày bé nhất trong Mảng (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Yeuvoyeucon

Thành viên hoạt động
Tham gia
30/10/09
Bài viết
143
Được thích
23
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 ạ.
Mã:
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
 
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 ạ.
Mã:
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.
 
Upvote 0
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 ạ.
Mã:
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ả.
Mã:
........
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
.........
 
Lần chỉnh sửa cuối:
Upvote 0
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 ạ.
Mã:
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.
 
Upvote 0
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ả.
Mã:
........
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:

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.
 
Upvote 0
Bạn cần Sort theo mấy trường (cột), nếu <=3 cột thì code Sort có 1 dòng à.
 
Upvote 0
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 ạ.
Mã:
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
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom