Sort dữ liệu nhiều điều kiện - nhờ giúp đỡ (3 người xem)

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)
C

caovanhau1507

Thành viên chính thức
Tham gia
17/7/12
Bài viết
79
Được thích
3
Chào các anh chị GPE,

Hiện tại, e có file theo dõi biến động giá chứng khoán, việc theo dõi biến động được tiến hành như sau:
- Dữ liệu được chia làm 3 sheet gồm giá, khối lượng và dư nợ;
- Cổ phiếu được chia làm 2 nhóm HNX và HSX;
- Biến động giá được chia làm 2 nhóm theo dõi: TĂNG nhiều nhất và GIẢM nhiều nhất;
- Sort và trích xuất biến động giá theo 2 bước:
+ B1: Sort TĂNG (GIẢM) theo cổ phiếu có dư nợ >= 500tr. Nếu kết quả trả về số lượng cp có biến động giá (% thay đổi giá <> 0%) ít hơn số lượng cần theo dõi (hiện tại là 5cp) thì thực hiện bước 2;
+ B2: Sort TĂNG (GIẢM) theo nhóm cổ phiểu có dư nợ <=500tr để bổ sung vào số lượng còn thiếu trong bước 1;
- Xuất BC ra theo mẫu định dạng sẵn.

Em có thực hiện bằng công thức bình thường thông qua các sheet tính toán phụ nhưng do dữ liệu là mảng động (số lượng dòng/cột tăng lên theo ngày) nên vệc tính toán bị chậm (thường rơi vào tình trạng calculating...)

Nhờ các anh chị tư vấn giúp e cách giải quyết, xử lý bằng formular hay VBA em đều cảm ơn :D

Trân trọng.
 

File đính kèm

caovanhau1507 đã viết:
Chào các anh chị GPE,

Hiện tại, e có file theo dõi biến động giá chứng khoán, việc theo dõi biến động được tiến hành như sau:
- Dữ liệu được chia làm 3 sheet gồm giá, khối lượng và dư nợ;
- Cổ phiếu được chia làm 2 nhóm HNX và HSX;
- Biến động giá được chia làm 2 nhóm theo dõi: TĂNG nhiều nhất và GIẢM nhiều nhất;
- Sort và trích xuất biến động giá theo 2 bước:
+ B1: Sort TĂNG (GIẢM) theo cổ phiếu có dư nợ >= 500tr. Nếu kết quả trả về số lượng cp có biến động giá (% thay đổi giá <> 0%) ít hơn số lượng cần theo dõi (hiện tại là 5cp) thì thực hiện bước 2;
+ B2: Sort TĂNG (GIẢM) theo nhóm cổ phiểu có dư nợ <=500tr để bổ sung vào số lượng còn thiếu trong bước 1;
- Xuất BC ra theo mẫu định dạng sẵn.

Em có thực hiện bằng công thức bình thường thông qua các sheet tính toán phụ nhưng do dữ liệu là mảng động (số lượng dòng/cột tăng lên theo ngày) nên vệc tính toán bị chậm (thường rơi vào tình trạng calculating...)

Nhờ các anh chị tư vấn giúp e cách giải quyết, xử lý bằng formular hay VBA em đều cảm ơn :D

Trân trọng.
Nhấp chuột vào đây để mở rộng...
bạn chạy thử code
Mã: 
Dim S As Long
Sub Report()
Dim Darr(), Arr(), Dic As Object, ngay As Date
Dim i As Long, LastR As Long, j As Long, LastC As Long, S_HNX As Long
Set Dic = CreateObject("Scripting.Dictionary")
ngay = Sheets("REPORT").Range("E19").Value
With Sheets("DEBT")
    LastC = WorksheetFunction.Match(ngay, .Range("A1:XAA1").Value, 0)
    LastR = .Range("A2").End(xlDown).Row
    Darr = .Range(.Range("A2"), .Cells(LastR, LastC)).Value
    S = UBound(Darr)
    ReDim Arr(1 To S, 1 To 5)
    For i = 1 To S
        Dic.Add Darr(i, 1), i
        Arr(i, 1) = Darr(i, 1): Arr(i, 2) = Darr(i, 2): Arr(i, 5) = Darr(i, LastC)
        If Darr(i, 2) = "HNX" Then S_HNX = S_HNX + 1
    Next i
End With
With Sheets("Price")
    LastC = WorksheetFunction.Match(ngay, .Range("A1:XAA1").Value, 0)
    LastR = .Range("A2").End(xlDown).Row
    Darr = .Range(.Range("A2"), .Cells(LastR, LastC)).Value
    For i = 1 To UBound(Darr)
        If Dic.exists(Darr(i, 1)) Then _
        Arr(Dic.Item(Darr(i, 1)), 3) = Darr(i, LastC) / Darr(i, LastC - 2)
    Next i
End With
With Sheets("Volumn")
    LastC = WorksheetFunction.Match(ngay, .Range("A1:XAA1").Value, 0)
    LastR = .Range("A2").End(xlDown).Row
    Darr = .Range(.Range("A2"), .Cells(LastR, LastC)).Value
    For i = 1 To UBound(Darr)
        If Dic.exists(Darr(i, 1)) Then _
        Arr(Dic.Item(Darr(i, 1)), 4) = (Darr(i, LastC) + Darr(i, LastC - 1)) / 2
    Next i
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Tam"
Sheets("Tam").Range("A1").Resize(S, 5) = Arr
Call Sort1
For i = 1 To S_HNX
    If Sheets("Tam").Cells(i, 5) < 500000000 And i > 10 Then
        Darr = Sheets("Tam").Range("A1:E" & i - 1).Value
        Exit For
    End If
Next i
For i = S_HNX + 1 To S
    If Sheets("Tam").Cells(i, 5) < 500000000 And i > S_HNX + 10 Then
        Arr = Sheets("Tam").Range("A" & S_HNX & ":E" & i - 1).Value
        Exit For
    End If
Next i
ActiveSheet.UsedRange.ClearContents
S = UBound(Darr)
Sheets("Tam").Range("A1").Resize(S, 5) = Darr
Call Sort2
Darr = Sheets("Tam").Range("A1:E5").Value
Sheets("REPORT").Range("C45:H49") = Darr
Call Sort3
Darr = Sheets("Tam").Range("A1:E5").Value
Sheets("REPORT").Range("C27:H31") = Darr
ActiveSheet.UsedRange.ClearContents
S = UBound(Arr)
Sheets("Tam").Range("A1").Resize(S, 5) = Arr
Call Sort2
Darr = Sheets("Tam").Range("A1:E5").Value
Sheets("REPORT").Range("C39:H43") = Darr
Call Sort3
Darr = Sheets("Tam").Range("A1:E5").Value
Sheets("REPORT").Range("C21:H25") = Darr
Sheets("Tam").Delete
Set Dic = Nothing:  Erase Darr: Erase Arr
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sub Sort1()
    Range("B2").Select
    ActiveWorkbook.Worksheets("Tam").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tam").Sort.SortFields.Add Key:=Range("B1:B" & S) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Tam").Sort.SortFields.Add Key:=Range("E1:E" & S) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tam").Sort
        .SetRange Range("A1:E" & S)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub Sort2()
    Range("B2").Select
    ActiveWorkbook.Worksheets("Tam").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tam").Sort.SortFields.Add Key:=Range("C1:C" & S) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tam").Sort
        .SetRange Range("A1:E" & S)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub Sort3()
    Range("B2").Select
    ActiveWorkbook.Worksheets("Tam").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tam").Sort.SortFields.Add Key:=Range("C1:C" & S) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tam").Sort
        .SetRange Range("A1:E" & S)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 
Cảm ơn a.Hiếu đã giúp đỡ :)

Anh ktra giúp e lại thử vì e run code báo lỗi từ hàm Match đầu tiên :(
 
caovanhau1507 đã viết:
Cảm ơn a.Hiếu đã giúp đỡ :)

Anh ktra giúp e lại thử vì e run code báo lỗi từ hàm Match đầu tiên :(
Nhấp chuột vào đây để mở rộng...
bạn chép thên đoạn code bẩy lổi (màu đỏ)
Mã: 
Dim S As Long
Sub Report()
Dim Darr(), Arr(), Dic As Object, ngay As Date
Dim i As Long, LastR As Long, j As Long, LastC As Long, S_HNX As Long
[COLOR=#ff0000]On Error GoTo Thoat[/COLOR]
[COLOR=#ff0000]If i = 2 Then[/COLOR]
[COLOR=#ff0000]Thoat:[/COLOR]
[COLOR=#ff0000]    MsgBox "Xem Lai !!!, Du Lieu Ngay Khong Dung"[/COLOR]
[COLOR=#ff0000]    Exit Sub[/COLOR]
[COLOR=#ff0000]End If[/COLOR]
Set Dic = CreateObject("Scripting.Dictionary")
ngay = Sheets("REPORT").Range("E19").Value
chạy code bạn sẽ hiểu làm gì
 
HieuCD đã viết:
bạn chép thên đoạn code bẩy lổi (màu đỏ)
Mã: 
Dim S As Long
Sub Report()
Dim Darr(), Arr(), Dic As Object, ngay As Date
Dim i As Long, LastR As Long, j As Long, LastC As Long, S_HNX As Long
[COLOR=#ff0000]On Error GoTo Thoat[/COLOR]
[COLOR=#ff0000]If i = 2 Then[/COLOR]
[COLOR=#ff0000]Thoat:[/COLOR]
[COLOR=#ff0000]    MsgBox "Xem Lai !!!, Du Lieu Ngay Khong Dung"[/COLOR]
[COLOR=#ff0000]    Exit Sub[/COLOR]
[COLOR=#ff0000]End If[/COLOR]
Set Dic = CreateObject("Scripting.Dictionary")
ngay = Sheets("REPORT").Range("E19").Value
chạy code bạn sẽ hiểu làm gì
Nhấp chuột vào đây để mở rộng...

Em gửi a file kèm code, a test lại giúp em.

Tất cả ngày trong file hiện tại là 26/12/2016, nhưng mà Match bị lỗi ko biết do đâu.
 

File đính kèm

caovanhau1507 đã viết:
Em gửi a file kèm code, a test lại giúp em.
Tất cả ngày trong file hiện tại là 26/12/2016, nhưng mà Match bị lỗi ko biết do đâu.
Nhấp chuột vào đây để mở rộng...
file của bạn Excel 2007 chạy bình thường
bạn chỉnh lại code chổ màu đỏ xem sao
Mã: 
With Sheets("DEBT")
    LastC = [COLOR=#ff0000]Application[/COLOR].Match(ngay, .Range("A1:XAA1").Value, 0)
    LastR = .Range("A2").End(xlDown).Row
    Darr = .Range(.Range("A2"), .Cells(LastR, LastC)).Value
    S = UBound(Darr)
    ReDim Arr(1 To S, 1 To 5)
    For i = 1 To S
        Dic.Add Darr(i, 1), i
        Arr(i, 1) = Darr(i, 1): Arr(i, 2) = Darr(i, 2): Arr(i, 5) = Darr(i, LastC)
        If Darr(i, 2) = "HNX" Then S_HNX = S_HNX + 1
    Next i
End With
With Sheets("Price")
    LastC =[COLOR=#ff0000] Application[/COLOR].Match(ngay, .Range("A1:XAA1").Value, 0)
    LastR = .Range("A2").End(xlDown).Row
    Darr = .Range(.Range("A2"), .Cells(LastR, LastC)).Value
    For i = 1 To UBound(Darr)
        If Dic.exists(Darr(i, 1)) Then _
        Arr(Dic.Item(Darr(i, 1)), 3) = Darr(i, LastC) / Darr(i, LastC - 2)
    Next i
End With
With Sheets("Volumn")
    LastC = [COLOR=#ff0000]Application[/COLOR].Match(ngay, .Range("A1:XAA1").Value, 0)
    LastR = .Range("A2").End(xlDown).Row
    Darr = .Range(.Range("A2"), .Cells(LastR, LastC)).Value
    For i = 1 To UBound(Darr)
        If Dic.exists(Darr(i, 1)) Then _
        Arr(Dic.Item(Darr(i, 1)), 4) = (Darr(i, LastC) + Darr(i, LastC - 1)) / 2
    Next i
End With
 
Trong code, chỗ nào là .Value thì sửa lại thành .Value2 và sửa ngay As Date thành ngay As Long là hết lỗi.
 
HieuCD đã viết:
file của bạn Excel 2007 chạy bình thường
bạn chỉnh lại code chổ màu đỏ xem sao
Mã: 
With Sheets("DEBT")
    LastC = [COLOR=#ff0000]Application[/COLOR].Match(ngay, .Range("A1:XAA1").Value, 0)
    LastR = .Range("A2").End(xlDown).Row
    Darr = .Range(.Range("A2"), .Cells(LastR, LastC)).Value
    S = UBound(Darr)
    ReDim Arr(1 To S, 1 To 5)
    For i = 1 To S
        Dic.Add Darr(i, 1), i
        Arr(i, 1) = Darr(i, 1): Arr(i, 2) = Darr(i, 2): Arr(i, 5) = Darr(i, LastC)
        If Darr(i, 2) = "HNX" Then S_HNX = S_HNX + 1
    Next i
End With
With Sheets("Price")
    LastC =[COLOR=#ff0000] Application[/COLOR].Match(ngay, .Range("A1:XAA1").Value, 0)
    LastR = .Range("A2").End(xlDown).Row
    Darr = .Range(.Range("A2"), .Cells(LastR, LastC)).Value
    For i = 1 To UBound(Darr)
        If Dic.exists(Darr(i, 1)) Then _
        Arr(Dic.Item(Darr(i, 1)), 3) = Darr(i, LastC) / Darr(i, LastC - 2)
    Next i
End With
With Sheets("Volumn")
    LastC = [COLOR=#ff0000]Application[/COLOR].Match(ngay, .Range("A1:XAA1").Value, 0)
    LastR = .Range("A2").End(xlDown).Row
    Darr = .Range(.Range("A2"), .Cells(LastR, LastC)).Value
    For i = 1 To UBound(Darr)
        If Dic.exists(Darr(i, 1)) Then _
        Arr(Dic.Item(Darr(i, 1)), 4) = (Darr(i, LastC) + Darr(i, LastC - 1)) / 2
    Next i
End With
Nhấp chuột vào đây để mở rộng...

Anh Hiếu cho em hỏi thêm,

Code anh viết hiện tại là áp dụng cho trường hợp các sheet này có 2 cột A-B giống nhau hoàn toàn. Nếu trong trường hợp khác nhau, giả sử sheet "Price" có mã XXX nhưng sheet "Volumn" lại bị thiếu thì có cách nào cho nó tìm và fill dữ liệu vào mảng chính xác không a :)
 
caovanhau1507 đã viết:
Anh Hiếu cho em hỏi thêm,

Code anh viết hiện tại là áp dụng cho trường hợp các sheet này có 2 cột A-B giống nhau hoàn toàn. Nếu trong trường hợp khác nhau, giả sử sheet "Price" có mã XXX nhưng sheet "Volumn" lại bị thiếu thì có cách nào cho nó tìm và fill dữ liệu vào mảng chính xác không a :)
Nhấp chuột vào đây để mở rộng...
Code chỉ lấy các mã có trong sheet DEBT nếu không có thì bỏ qua không xét vì yêu cầu là phải lấy dư nợ >...., các sheet khác chỉ lấy theo mã giống sheet DEBT thứ tự không quan trọng
 
caovanhau1507 đã viết:
Cảm ơn anh,
Em đã thực hiện được :)

Cho em hỏi, Ngay as Long thì e đã hiểu nhưng .value và .value2 khác nhau như thế nào vậy a?
Nhấp chuột vào đây để mở rộng...
Trong Help của Excel có đó bạn. Tôi không nhớ rõ nhưng nôm na là với ngày giờ .Value2 lấy giá trị thực (kiểu Double) chứ không phải giá trị ngày giờ (kiểu Date, Time)
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

H
Chuyển file *xml hóa đơn điện tử sang excel (1 người xem)
    • Thích
Trả lời
6
Đọc
248
htrunga2
H
P
Phát âm thanh tiếng việt cho dữ liệu trong file excel
Trả lời
1
Đọc
11
thuytrangbp28
T
queluatb
  • Question Question
Lấy hóa đơn đầu vào cho hóa đơn đầu ra (1 người xem)
Trả lời
0
Đọc
41
queluatb
queluatb
P
Xin tư vấn về cách tạo bảng quản lý vải
    • Cười
Trả lời
16
Đọc
288
pycckuu410
pycckuu410
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
16 17 18
Trả lời
349
Đọc
31K
tuanktt3
T
N
xin các cao thủ chỉ cách gỡ lỗi không khởi động được excel (3 người xem)
Trả lời
0
Đọc
39
nguyentuan1291
N
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table
Trả lời
7
Đọc
291
ptm0412
ptm0412
D
Nhờ các bác giúp đỡ vấn đề tìm kiếm dữ liệu
Trả lời
6
Đọc
179
Hoàng Tuấn 868
H
P
Hỏi về cách dò tìm từ dưới lên trên, dò tìm trong 2 bảng
Trả lời
7
Đọc
202
kenytien
K
D
Nhờ giúp đỡ về công thức xếp loại rèn luyện theo thông tư 22/2021/TT-BGDĐT
Trả lời
8
Đọc
152
thanthanhan
T
Maika8008
Tặng file quản lý vật tư - công nợ (nhập xuất kho hàng và công nợ khách hàng) (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
116
Đọc
25K
Thanh Tam 07
T
D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ
2
Trả lời
25
Đọc
933
befaint
befaint
A
Lấy trường dữ liệu trong file hóa đơn dạng *.xml
Trả lời
1
Đọc
139
ongke0711
ongke0711
K
Lọc một mã sản phẩm có nhiều đơn giá thành một file riêng
Trả lời
2
Đọc
136
ketoansb123
K
D
Nhờ trợ giúp xác định thứ tự của các từ và cụm từ trong 1 chuỗi văn bản.
Trả lời
10
Đọc
287
Phuocam
Phuocam
1
Vướng mắc về hàm lấy tên đăng nhập máy tính ạ (2 người xem)
Trả lời
19
Đọc
598
thuytrangbp28
T
Trungvt3
Công thức trả về định dạng không như mong muốn và viết phân số trong 1 ô.
Trả lời
6
Đọc
207
Trungvt3
Trungvt3
H
  • Question Question
Tô đậm tiêu đề cho cho các sheet
Trả lời
4
Đọc
205
hieu998
H
GPE-Trợ Lý
[GPE] HỘI THẢO POWER QUERY – CÔNG CỤ QUẢN LÝ DỮ LIỆU HCM
    • Thích
Trả lời
1
Đọc
1K
GPE-Trợ Lý
GPE-Trợ Lý
Z
TRỢ GIÚP K SORT ĐƯỢC THỨ TỰ NGÀY THÁNG NĂM TRONG EXCEL
Trả lời
2
Đọc
139
Duy Tùng 9x
Duy Tùng 9x
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
[GPE] HỘI THẢO POWER QUERY – CÔNG CỤ QUẢN LÝ DỮ LIỆU HCM
Back
Top Bottom