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

Elx Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Yeuvoyeucon đã viết:
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
Nhấp chuột vào đây để mở rộng...
Đ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
Yeuvoyeucon đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
Yeuvoyeucon đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
HUONGHCKT đã viết:
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
.........
Nhấp chuột vào đây để mở rộng...
Dạ, để em tham khảo và làm tiếp ạ !
Bài đã được tự động gộp:

snow25 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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
Yeuvoyeucon đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

A
  • Question Question
Sửa code VBA nhập liệu userform (5 người xem)
Trả lời
25
Đọc
1K
Mr.hieudoanxd
Mr.hieudoanxd
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (9 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
556
Đọc
72K
sát thủ uyên ương
S
C
Fix lỗi Application.InputBox Type:=8 (2 người xem)
    • Cười
Trả lời
6
Đọc
107
SA_DQ
SA_DQ
Emyeuexcel
Tham chiếu về 1 ô-lấy ra và lọc dữ liệu
Trả lời
5
Đọc
91
Emyeuexcel
Emyeuexcel
L
Hỏi lỗi excel bị tràn trang khi in (1 người xem)
Trả lời
3
Đọc
71
Hoàng Tuấn 868
H
E
  • Question Question
VBA tự động thay đổi tham chiếu vùng (range và cell) khi insert dòng cột trong sheet tính toán (1 người xem)
    • Cười
Trả lời
5
Đọc
123
eagle12
E
D
Tổng hợp dữ liệu từ các sheet sang sheet tổng (1 người xem)
Trả lời
3
Đọc
146
dohungmo
D
T
font chu trong excel
Trả lời
2
Đọc
72
Hoàng Tuấn 868
H
khuong182018
  • Question Question
Nhờ anh chị sửa lỗi setfocus ở textbox (1 người xem)
Trả lời
9
Đọc
165
khuong182018
khuong182018
N
File chia băng tự động từ cuộn mẹ theo khổ băng và khối lượng băng cho trước
Trả lời
0
Đọc
43
nguyenanhtruong2409
N
SA_DQ
Copilot bình luận về một ván cờ vua
Trả lời
0
Đọc
75
SA_DQ
SA_DQ
T
Xin giúp đỡ lọc dữ liệu
    • Cười
Trả lời
4
Đọc
114
pycckuu410
pycckuu410
Nguyễn Duy Tuân
[New] BSAC v3.0 bộ công cụ lập trình phần mềm chuyên nghiệp trong VBA
    • Thích
Trả lời
13
Đọc
4K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
H
  • Question Question
Code Sổ Chi Tiết Tài Khoản
Trả lời
8
Đọc
328
hieuvietmy2020
H
befaint
Chia sẻ tâm tư, xả nỗi lòng (4 người xem)
    • Thích
6 7 8
Trả lời
778
Đọc
75K
SA_DQ
SA_DQ
H
Chia sẻ file in Phiếu điều tra PCGD (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
12
Đọc
443
HUONGHCKT
H
V
Hỏi công thức để làm khối lượng trong xây dựng. Xin cảm ơn
Trả lời
11
Đọc
522
phanphu_91
P
Linhnv0001
Hỏi - Cách kiểm tra laptop là hàng lắp ráp hay không
Trả lời
3
Đọc
275
Lê Duy Thương
Lê Duy Thương
K
Nhờ anh chị làm công thức lọc dữ kiện ngày từ bảng 1 sang rút gọn ngày ở bảng 2.
Trả lời
2
Đọc
186
Lê Duy Thương
Lê Duy Thương
L
[Mẹo] Không chọn Add-in vẫn có thể sử dụng được chức năng của Add-in, giảm tốc độ loading của Excel.
    • Thích
Trả lời
2
Đọc
498
HeSanbi
HeSanbi
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom