Code sắp xếp lại thứ tự góc theo yêu cầu (1 người xem)

  • Thread starter Thread starter AnhNQT
  • Ngày gửi Ngày gửi
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)
AnhNQT

AnhNQT

Thành viên chính thức
Tham gia
6/11/18
Bài viết
61
Được thích
5
Giới tính
Nam
Nhờ các Thầy giúp bài này với ạ!
Dữ liệu có từ cột A -> D
Số liệu cần kiểm tra và sắp xếp ở cột D với giá trị nằm trong khoảng từ 0 đến 359 độ
Cột E là kết quả sau khi kiểm tra và sắp xếp theo điều kiện 1
Điều kiện 1 là: Sắp xếp lại từ nhỏ tới lớn
Cột F là kết quả sau khi kiểm tra và sắp xếp theo điều kiện 2
Điều kiện 2 là: Sắp xếp lại với điều kiện so sánh
Nếu Azm nằm trong khoảng từ 300 đến 60 (300 310 320 330 340 350 0 10 20 30 40 50 60) 360 tức là 0 độ
Thì sẽ tìm giá trị nào nằm gần 0 nhất sẽ sắp xếp lên vị trí ID-1 (Ví dụ: so sánh 320 và 60 thì 320 là số gần 0 nhất)
Vị trí ID-2 và ID-3 sẽ sắp xếp 2 giá trị còn lại từ nhỏ tới lớn.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
AnhNQT đã viết:
Nhờ các Thầy giúp bài này với ạ!
Dữ liệu có từ cột A -> D
Số liệu cần kiểm tra và sắp xếp ở cột D với giá trị nằm trong khoảng từ 0 đến 359 độ
Cột E là kết quả sau khi kiểm tra và sắp xếp theo điều kiện 1
Điều kiện 1 là: Sắp xếp lại từ nhỏ tới lớn
Cột F là kết quả sau khi kiểm tra và sắp xếp theo điều kiện 2
Điều kiện 2 là: Sắp xếp lại với điều kiện so sánh
Nếu Azm nằm trong khoảng từ 300 đến 60 (300 310 320 330 340 350 0 10 20 30 40 50 60) 360 tức là 0 độ
Thì sẽ tìm giá trị nào nằm gần 0 nhất sẽ sắp xếp lên vị trí ID-1 (Ví dụ: so sánh 320 và 60 thì 320 là số gần 0 nhất)
Vị trí ID-2 và ID-3 sẽ sắp xếp 2 giá trị còn lại từ nhỏ tới lớn.
Nhấp chuột vào đây để mở rộng...
Chèn thêm sheet2 rồi chạy code dưới đây.
Mã: 
Sub Sort()
Dim DArr
Dim Min, Max
Dim Azm, Rws
Dim Res
Dim i, j, k, x, z, t
DArr = Sheet1.Range("A2", Sheet1.Range("D2").End(xlDown))
Azm = Sheet1.Range("D2", Sheet1.Range("D2").End(xlDown))
k = UBound(DArr)
ReDim Res(1 To k, 1 To UBound(DArr, 2))
Min = DArr(k, 4)
Max = DArr(k, 4)
If DArr(k, 4) < 360 - DArr(k, 4) Then
    t = DArr(k, 4)
Else
    t = 360 - DArr(k, 4)
End If
ReDim Rws(1 To k, 1 To 1)
For i = 1 To k
    Rws(i, 1) = i
Next i
For i = 1 To k - 1
    If Min > DArr(i, 4) Then Min = DArr(i, 4)
    If Max < DArr(i, 4) Then Max = DArr(i, 4)
    If DArr(i, 4) < 360 - DArr(i, 4) Then
        If t > DArr(i, 4) Then
            t = DArr(i, 4)
            z = i
        End If
    Else
        If t > 360 - DArr(i, 4) Then
            t = 360 - DArr(i, 4)
            z = i
        End If
    End If
    For j = i + 1 To k
        If Azm(i, 1) > Azm(j, 1) Then
            x = Azm(i, 1)
            Azm(i, 1) = Azm(j, 1)
            Azm(j, 1) = x
            x = Rws(i, 1)
            Rws(i, 1) = Rws(j, 1)
            Rws(j, 1) = x
        End If
    Next j
Next i
t = UBound(DArr, 2)
If Min <= 60 And Max >= 300 Then
    For j = 1 To t
        Res(1, j) = DArr(z, j)
    Next j
    x = 1
    For i = 1 To k
        If Rws(i, 1) <> z Then
            x = x + 1
            For j = 1 To t
                Res(x, j) = DArr(Rws(i, 1), j)
            Next j
        End If
    Next i
Else
    For i = 1 To k
        For j = 1 To t
            Res(i, j) = DArr(Rws(i, 1), j)
        Next j
    Next i
End If
With Sheets("Sheet2")
    .UsedRange.Clear
    .Range("A2").Resize(k, t) = Res
    .UsedRange.Columns.AutoFit
End With
End Sub
 
Upvote 0
Dạ cảm ơn bác @CHAOQUAY ạ. Đoạn code này đã giải quyết được 90% vấn đề của điều kiện 2 rồi ạ. Tuy nhiên em cần sắp xếp và đặt lại ID nữa ạ.
Sắp xếp trước là 1-210; 2-320; 3-60 sau khi kiểm tra sẽ ra kết quả là 1-320; 2-60; 3-120.
Ngoài ra còn điều kiện 1 em cũng k biết làm ạ :(

IDAzmCorrect Azm (Type 1)Correct Azm (Type 2)
1​
210​
60​
320​
2​
320​
210​
60​
3​
60​
320​
210​
 
Upvote 0
AnhNQT đã viết:
Dạ cảm ơn bác @CHAOQUAY ạ. Đoạn code này đã giải quyết được 90% vấn đề của điều kiện 2 rồi ạ. Tuy nhiên em cần sắp xếp và đặt lại ID nữa ạ.
Sắp xếp trước là 1-210; 2-320; 3-60 sau khi kiểm tra sẽ ra kết quả là 1-320; 2-60; 3-120.
Ngoài ra còn điều kiện 1 em cũng k biết làm ạ :(

IDAzmCorrect Azm (Type 1)Correct Azm (Type 2)
1​
210​
60​
320​
2​
320​
210​
60​
3​
60​
320​
210​
Nhấp chuột vào đây để mở rộng...

Tức là sau khi sort thì thay đổi ID mới?
Bạn gửi file đính kèm lên cho dễ hiểu.

Kết quả muốn hiển thị thế nào?
 
Upvote 0
AnhNQT đã viết:
Đúng rồi ạ. Kết quả em muốn hiển thị ra trong 2 cột E hoặc F ạ.
Nhấp chuột vào đây để mở rộng...
Sửa ID không thành vấn đề.
Bạn làm 1 bảng kết quả cần hiển thị để sửa code 1 thể
Bài đã được tự động gộp:

Không hiểu hiển thị kết quả vào cột E, F là thế nào.
Chạy code này xem sao, có gì tính sau.
Mã: 
Sub Sort_()
Dim DArr
Dim Min, Max
Dim Azm, Rws
Dim Res
Dim i, j, k, x, z, t
DArr = Sheet1.Range("A2", Sheet1.Range("D2").End(xlDown))
Azm = Sheet1.Range("D2", Sheet1.Range("D2").End(xlDown))
k = UBound(DArr)
ReDim Res(1 To k, 1 To UBound(DArr, 2))
Min = DArr(k, 4)
Max = DArr(k, 4)
If DArr(k, 4) < 360 - DArr(k, 4) Then
    t = DArr(k, 4)
Else
    t = 360 - DArr(k, 4)
End If
ReDim Rws(1 To k, 1 To 1)
For i = 1 To k
    Rws(i, 1) = i
Next i
For i = 1 To k - 1
    If Min > DArr(i, 4) Then Min = DArr(i, 4)
    If Max < DArr(i, 4) Then Max = DArr(i, 4)
    If DArr(i, 4) < 360 - DArr(i, 4) Then
        If t > DArr(i, 4) Then
            t = DArr(i, 4)
            z = i
        End If
    Else
        If t > 360 - DArr(i, 4) Then
            t = 360 - DArr(i, 4)
            z = i
        End If
    End If
    For j = i + 1 To k
        If Azm(i, 1) > Azm(j, 1) Then
            x = Azm(i, 1)
            Azm(i, 1) = Azm(j, 1)
            Azm(j, 1) = x
            x = Rws(i, 1)
            Rws(i, 1) = Rws(j, 1)
            Rws(j, 1) = x
        End If
    Next j
Next i
t = UBound(DArr, 2)
If Min <= 60 And Max >= 300 Then
    Res(1, 4) = DArr(z, 4)
    For j = 1 To t - 1
        Res(1, j) = Replace(DArr(z, j), z, 1)
    Next j
    x = 1
    For i = 1 To k
        If Rws(i, 1) <> z Then
            x = x + 1
            Res(x, 4) = DArr(Rws(i, 1), 4)
            For j = 1 To t - 1
                Res(x, j) = Replace(DArr(Rws(i, 1), j), Rws(i, 1), x)
            Next j
        End If
    Next i
Else
    For i = 1 To k
        Res(i, 4) = DArr(Rws(i, 1), 4)
        For j = 1 To t - 1
            Res(i, j) = Replace(DArr(Rws(i, 1), j), Rws(i, 1), i)
        Next j
    Next i
End If
With Sheets("Sheet2")
    .UsedRange.Clear
    .Range("A2").Resize(k, t) = Res
    .UsedRange.Columns.AutoFit
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
CHAOQUAY đã viết:
Sửa ID không thành vấn đề.
Bạn làm 1 bảng kết quả cần hiển thị để sửa code 1 thể
Nhấp chuột vào đây để mở rộng...
Không thành vấn đề sao được? ID trên nguyên tắc là một mã số cố định. Tự căn bản, từ "identity" nó đã mang nghĩa "xác định".
Nếu thay đổi được thì là do chọn tên sai, phải là STT hay cái gì đó.
 
Upvote 0
CHAOQUAY đã viết:
Sửa ID không thành vấn đề.
Bạn làm 1 bảng kết quả cần hiển thị để sửa code 1 thể
Bài đã được tự động gộp:

Không hiểu hiển thị kết quả vào cột E, F là thế nào.
Chạy code này xem sao, có gì tính sau.
Mã: 
Sub Sort_()
Dim DArr
Dim Min, Max
Dim Azm, Rws
Dim Res
Dim i, j, k, x, z, t
DArr = Sheet1.Range("A2", Sheet1.Range("D2").End(xlDown))
Azm = Sheet1.Range("D2", Sheet1.Range("D2").End(xlDown))
k = UBound(DArr)
ReDim Res(1 To k, 1 To UBound(DArr, 2))
Min = DArr(k, 4)
Max = DArr(k, 4)
If DArr(k, 4) < 360 - DArr(k, 4) Then
    t = DArr(k, 4)
Else
    t = 360 - DArr(k, 4)
End If
ReDim Rws(1 To k, 1 To 1)
For i = 1 To k
    Rws(i, 1) = i
Next i
For i = 1 To k - 1
    If Min > DArr(i, 4) Then Min = DArr(i, 4)
    If Max < DArr(i, 4) Then Max = DArr(i, 4)
    If DArr(i, 4) < 360 - DArr(i, 4) Then
        If t > DArr(i, 4) Then
            t = DArr(i, 4)
            z = i
        End If
    Else
        If t > 360 - DArr(i, 4) Then
            t = 360 - DArr(i, 4)
            z = i
        End If
    End If
    For j = i + 1 To k
        If Azm(i, 1) > Azm(j, 1) Then
            x = Azm(i, 1)
            Azm(i, 1) = Azm(j, 1)
            Azm(j, 1) = x
            x = Rws(i, 1)
            Rws(i, 1) = Rws(j, 1)
            Rws(j, 1) = x
        End If
    Next j
Next i
t = UBound(DArr, 2)
If Min <= 60 And Max >= 300 Then
    Res(1, 4) = DArr(z, 4)
    For j = 1 To t - 1
        Res(1, j) = Replace(DArr(z, j), z, 1)
    Next j
    x = 1
    For i = 1 To k
        If Rws(i, 1) <> z Then
            x = x + 1
            Res(x, 4) = DArr(Rws(i, 1), 4)
            For j = 1 To t - 1
                Res(x, j) = Replace(DArr(Rws(i, 1), j), Rws(i, 1), x)
            Next j
        End If
    Next i
Else
    For i = 1 To k
        Res(i, 4) = DArr(Rws(i, 1), 4)
        For j = 1 To t - 1
            Res(i, j) = Replace(DArr(Rws(i, 1), j), Rws(i, 1), i)
        Next j
    Next i
End If
With Sheets("Sheet2")
    .UsedRange.Clear
    .Range("A2").Resize(k, t) = Res
    .UsedRange.Columns.AutoFit
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ code này OK rồi đó ạ. Em cần hiển thị thêm kết quả vào cột F sheet "Azm" ạ.
Ngoài ra nhờ Bác thêm đoạn code sắp xếp góc từ nhỏ tới lớn nữa ạ, Kết quả hiển thị vào cột E sheet "Azm"
Em cảm ơn Bác nhiều!
 
Upvote 0
AnhNQT đã viết:
Dạ code này OK rồi đó ạ. Em cần hiển thị thêm kết quả vào cột F sheet "Azm" ạ.
Ngoài ra nhờ Bác thêm đoạn code sắp xếp góc từ nhỏ tới lớn nữa ạ, Kết quả hiển thị vào cột E sheet "Azm"
Em cảm ơn Bác nhiều!
Nhấp chuột vào đây để mở rộng...
Vậy các cột A, B, C, D thì thế nào, thay đổi thế nào cho phù hợp 2 cách sort?
VetMini đã viết:
Không thành vấn đề sao được? ID trên nguyên tắc là một mã số cố định. Tự căn bản, từ "identity" nó đã mang nghĩa "xác định".
Nếu thay đổi được thì là do chọn tên sai, phải là STT hay cái gì đó.
Nhấp chuột vào đây để mở rộng...
Hình như là thớt muốn thay đổi số liệu đầu vào bác ạ.
 
Upvote 0
CHAOQUAY đã viết:
Vậy các cột A, B, C, D thì thế nào, thay đổi thế nào cho phù hợp 2 cách sort?

Hình như là thớt muốn thay đổi số liệu đầu vào bác ạ.
Nhấp chuột vào đây để mở rộng...
Dạ A B C D sẽ vẫn giữ nguyên ạ, kiểm tra số liệu cột D xem đúng quy tắc đặt ra không ạ, kết quả đúng sẽ được đẩy vào cột E và F.
Nếu như code hiện tại thì em sẽ thêm bước Vlookup giá trị từ "sheet 2" vào "Azm" với tham chiếu là "Ha_Noi_1"
 
Upvote 0
Còn một vấn đề nữa là khi có 2 giá trị 60 và 300 thì code chạy báo lỗi ạ.
Ngoài ra Bác sửa giúp em hàm vlookup này với.
For i = 2 To Nbrow Cells(i, 5) = Application.WorksheetFunction.VLookup(Cells(i, 2), Sheets("Sheet2").Range("B:D"), 3, 0) Next i
Site​
Cell​
ID​
Azm​
Ha_Noi​
Ha_Noi_1​
1​
210​
Ha_Noi​
Ha_Noi_2​
2​
300​
Ha_Noi​
Ha_Noi_3​
3​
60​
 
Upvote 0
AnhNQT đã viết:
Dạ A B C D sẽ vẫn giữ nguyên ạ, kiểm tra số liệu cột D xem đúng quy tắc đặt ra không ạ, kết quả đúng sẽ được đẩy vào cột E và F.
Nếu như code hiện tại thì em sẽ thêm bước Vlookup giá trị từ "sheet 2" vào "Azm" với tham chiếu là "Ha_Noi_1"
Nhấp chuột vào đây để mở rộng...
AnhNQT đã viết:
Còn một vấn đề nữa là khi có 2 giá trị 60 và 300 thì code chạy báo lỗi ạ.
Ngoài ra Bác sửa giúp em hàm vlookup này với.
For i = 2 To Nbrow Cells(i, 5) = Application.WorksheetFunction.VLookup(Cells(i, 2), Sheets("Sheet2").Range("B:D"), 3, 0) Next i
Site​
Cell​
ID​
Azm​
Ha_Noi​
Ha_Noi_1​
1​
210​
Ha_Noi​
Ha_Noi_2​
2​
300​
Ha_Noi​
Ha_Noi_3​
3​
60​
Nhấp chuột vào đây để mở rộng...

Bạn làm vào 1 file nào đó rồi gửi lên. Đọc không hiểu gì hết
 
Upvote 0
AnhNQT đã viết:
Dạ em gửi file nhờ Bác xử lý giúp!
Nhấp chuột vào đây để mở rộng...
Code bài 6, thay các dấu ">"; "<" thành ">="; "<=" là hết lỗi

Theo bài 1, bạn có viết:
AnhNQT đã viết:
Nhờ các Thầy giúp bài này với ạ!
Dữ liệu có từ cột A -> D
Số liệu cần kiểm tra và sắp xếp ở cột D với giá trị nằm trong khoảng từ 0 đến 359 độ
Cột E là kết quả sau khi kiểm tra và sắp xếp theo điều kiện 1
Điều kiện 1 là: Sắp xếp lại từ nhỏ tới lớn
Cột F là kết quả sau khi kiểm tra và sắp xếp theo điều kiện 2
Điều kiện 2 là: Sắp xếp lại với điều kiện so sánh
Nếu Azm nằm trong khoảng từ 300 đến 60 (300 310 320 330 340 350 0 10 20 30 40 50 60) 360 tức là 0 độ
Thì sẽ tìm giá trị nào nằm gần 0 nhất sẽ sắp xếp lên vị trí ID-1 (Ví dụ: so sánh 320 và 60 thì 320 là số gần 0 nhất)
Vị trí ID-2 và ID-3 sẽ sắp xếp 2 giá trị còn lại từ nhỏ tới lớn.
Nhấp chuột vào đây để mở rộng...
Phần bôi đỏ tôi hiểu là: chỉ khi nào thỏa điều kiện thì mới sắp xếp, không thỏa thì không xếp --> 1 bảng số liệu chỉ có thể xếp theo cách 1 hoặc là 2.
2 đoạn code viết ở trên là theo cách hiểu này.

Có lẽ là không hiểu được ý của bạn, dừng tại đây.
Thân chào!
 
Upvote 0
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

dung1983
Hỏi về import - Table/ XML cho bảng, trang có chứa JS
Trả lời
1
Đọc
75
DeTong
D
hoangluongvinh
Cách nhặt các dữ liệu bị trùng của 1 đối tượng
Trả lời
9
Đọc
195
RaidbossVN
RaidbossVN
T
  • Question Question
Lọc dữ liệu có nhiều điều kiện
Trả lời
3
Đọc
143
hoangtuaotrang_hp_vn
H
X
add-in báo lỗi mỗi khi mở file
Trả lời
1
Đọc
38
HeSanbi
HeSanbi
K
cố định, không thay đổi kích thước, ( fit) độ rộng dòng, cột
Trả lời
3
Đọc
47
HeSanbi
HeSanbi
NguyenBaChien
Nhờ tách lấy số và tính tổng có điều kiện của dãy số
Trả lời
4
Đọc
91
hongphuong1997
hongphuong1997
HeSanbi
  • Question Question
VBA nâng cao: Nhúng tập tin vào trang tính hoặc trích xuất chúng nhanh chóng
    • Thích
    • Cảm ơn
Trả lời
1
Đọc
234
HeSanbi
HeSanbi
H
xin mọi người giúp em làm tròn với ạ
Trả lời
5
Đọc
112
vietduc147258
V
L
[Xin giúp] Cách copy công thức từ bảng tham chiếu vào một ô
Trả lời
2
Đọc
65
Lá chanh
L
N
  • Question Question
Cách viết tiếng việt có dấu trong msgbox,....... Hoàn toàn mới (1 người xem)
    • Thích
2
Trả lời
35
Đọc
5K
ligktit
L
longhungvnpost
cả nhà giúp e tạo ô tìm kiếm gợi ý trong danh sách nhé
Trả lời
3
Đọc
120
longhungvnpost
longhungvnpost
S
Cố định độ rộng/ cao của cột/hàng?
Trả lời
12
Đọc
17K
khanhnth02
K
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
329
Đọc
26K
tt_kimbai
T
HeSanbi
  • Đã giải quyết
VBA_FastCode v2.22 - Công cụ học và viết mã VBA một cách nhanh nhất (*27/10/2023)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3
Trả lời
51
Đọc
15K
HeSanbi
HeSanbi
Manhhung90
Mail merge in ấn theo từng trang mong muốn.
Trả lời
1
Đọc
112
Hoàng Tuấn 868
H
L
Xin giúp đỡ đổi màu chữ trong mathtype powerpoint sang màu đen
Trả lời
4
Đọc
135
LINHCM
L
ongke0711
  • Question Question
Form Đăng nhập và phân quyền cơ bản
    • Thích
2 3
Trả lời
40
Đọc
5K
Gà Công Nghệ
Gà Công Nghệ
vnxgiokinhtoi
Nhờ giúp đỡ công thức lưu dữ liệu và mở lại dữ liệu cũ đã save
Trả lời
6
Đọc
217
DeTong
D
A
  • Question Question
Addin lúc hiện lúc không
Trả lời
1
Đọc
114
anhdepjai
A
T
  • Question Question
Ẩn hiện các sheet khi click vào HyperLink
Trả lời
6
Đọc
305
Gà Công Nghệ
Gà Công Nghệ
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
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom