Sắp xếp data theo dựa theo bảng cho sẵn. (1 người xem)

Thùy Anh 96 · 17/7/24

Em chào anh chị !
Hiện tại em có 1 vấn đề về việc sắp xếp dữ liệu dựa theo một bảng cho trước ạ.
Anh chị xem file đính kèm giúp e để hiểu rõ hơn ạ.
Cụ thể là em có 3 Table
- Tabel 1 là bảng thứ tự các màu sắp xếp từ trên xuống dưới.
- Table 3 là bảng dữ liệu em đã xuất ra.( data ở tablr có thể nhiều hoặc ít hơn)
- Table 2 là bảng em mong muốn sắp xếp theo thứ tự như vậy.
Cụ thể hơn nữa là. Em muốn lấy data ở Table số 3 sẽ sắp xếp theo thứ tự giống như ở Table 1 và khi kết thúc màu này thì nó sẽ cách ra 1 dòng sau đó lại đến màu tiếp theo ạ
Mong anh chị giúp đỡ ạ.
Em cảm ơn !

Phuocam · 17/7/24

Thùy Anh 96 đã viết:
Em chào anh chị !
Hiện tại em có 1 vấn đề về việc sắp xếp dữ liệu dựa theo một bảng cho trước ạ.
Anh chị xem file đính kèm giúp e để hiểu rõ hơn ạ.
Cụ thể là em có 3 Table
- Tabel 1 là bảng thứ tự các màu sắp xếp từ trên xuống dưới.
- Table 3 là bảng dữ liệu em đã xuất ra.( data ở tablr có thể nhiều hoặc ít hơn)
- Table 2 là bảng em mong muốn sắp xếp theo thứ tự như vậy.
Cụ thể hơn nữa là. Em muốn lấy data ở Table số 3 sẽ sắp xếp theo thứ tự giống như ở Table 1 và khi kết thúc màu này thì nó sẽ cách ra 1 dòng sau đó lại đến màu tiếp theo ạ
Mong anh chị giúp đỡ ạ.
Em cảm ơn !

.
Nếu không có dòng trống phân cách giữa các mã, có thể dùng công thức sau:

=SORTBY(K3:L21,MATCH(K3:K21,B3:B9,0))

Thùy Anh 96 · 17/7/24

Phuocam đã viết:
.
Nếu không có dòng trống phân cách giữa các mã, có thể dùng công thức sau:

=SORTBY(K3:L21,MATCH(K3:K21,B3:B9,0))

Em muốn nó có dòng cách đó nên nhờ anh chị giúp đỡ ạ.

SA_DQ · 17/7/24

Bạn thử với con rùa bò này xem đúng ý bạn chưa?

PHP:

Sub SapXepTheoMau()     'FIND() '
 Dim Rws As Long, W As Integer, Dng As Integer
 Dim Rng As Range, sRng As Range, Cls As Range
 Dim MyAdd As String
 
 Dng = [B3].CurrentRegion.Rows.Count
 Rws = [K3].CurrentRegion.Rows.Count
 ReDim Arr(1 To (Dng + Rws + 9), 1 To 2)
 [H3].Resize(Dng + Rws + 9, 2).Value = Arr()    'Xóa Du Liêu Lân Truóc  '
 Set Rng = [K2].Resize(Rws)
 For Each Cls In Range([B3], [B3].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        W = W + 1
        MyAdd = sRng.Address
        Do
            Arr(W, 1) = sRng.Value:         Arr(W, 2) = sRng.Offset(, 1).Value
            W = W + 1
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next Cls
 [H3].Resize(W, 2).Value = Arr()
End Sub

longtay1111 · 17/7/24

Thùy Anh 96 đã viết:
Em chào anh chị !
Hiện tại em có 1 vấn đề về việc sắp xếp dữ liệu dựa theo một bảng cho trước ạ.
Anh chị xem file đính kèm giúp e để hiểu rõ hơn ạ.
Cụ thể là em có 3 Table
- Tabel 1 là bảng thứ tự các màu sắp xếp từ trên xuống dưới.
- Table 3 là bảng dữ liệu em đã xuất ra.( data ở tablr có thể nhiều hoặc ít hơn)
- Table 2 là bảng em mong muốn sắp xếp theo thứ tự như vậy.
Cụ thể hơn nữa là. Em muốn lấy data ở Table số 3 sẽ sắp xếp theo thứ tự giống như ở Table 1 và khi kết thúc màu này thì nó sẽ cách ra 1 dòng sau đó lại đến màu tiếp theo ạ
Mong anh chị giúp đỡ ạ.
Em cảm ơn !

Tại

E3= IF(COUNT(FIND(E2,E$2:E2))=COUNTIF($K$3:$K$21,E2),"",INDEX($B$3:$B$9,AGGREGATE(15,6,(MATCH($K$3:$K$21,$B$3:$B$9,0)),COUNTIF(E$2:E2,"*?")+1)))

F3=IF(E3="","",INDEX($L$3:$L$21,AGGREGATE(15,6,ROW($1:$30)/(E3=$K$3:$K$21),COUNTIF($E$3:E3,E3))))

Bạn xem trong file đính kèm

Thùy Anh 96 · 17/7/24

SA_DQ đã viết:

Bạn thử với con rùa bò này xem đúng ý bạn chưa?

PHP:

Sub SapXepTheoMau()     'FIND() '
 Dim Rws As Long, W As Integer, Dng As Integer
 Dim Rng As Range, sRng As Range, Cls As Range
 Dim MyAdd As String
 
 Dng = [B3].CurrentRegion.Rows.Count
 Rws = [K3].CurrentRegion.Rows.Count
 ReDim Arr(1 To (Dng + Rws + 9), 1 To 2)
 [H3].Resize(Dng + Rws + 9, 2).Value = Arr()    'Xóa Du Liêu Lân Truóc  '
 Set Rng = [K2].Resize(Rws)
 For Each Cls In Range([B3], [B3].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        W = W + 1
        MyAdd = sRng.Address
        Do
            Arr(W, 1) = sRng.Value:         Arr(W, 2) = sRng.Offset(, 1).Value
            W = W + 1
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next Cls
 [H3].Resize(W, 2).Value = Arr()
End Sub

Code chạy ok rồi ạ. Em cảm ơn ạ

Bài đã được tự động gộp: 17/7/24

longtay1111 đã viết:
Tại

E3= IF(COUNT(FIND(E2,E$2:E2))=COUNTIF($K$3:$K$21,E2),"",INDEX($B$3:$B$9,AGGREGATE(15,6,(MATCH($K$3:$K$21,$B$3:$B$9,0)),COUNTIF(E$2:E2,"*?")+1)))

F3=IF(E3="","",INDEX($L$3:$L$21,AGGREGATE(15,6,ROW($1:$30)/(E3=$K$3:$K$21),COUNTIF($E$3:E3,E3))))

Bạn xem trong file đính kèm

Đúng với ý e luôn ạ. Cảm ơn sự giúp đỡ của anh chị ạ

Thùy Anh 96 · 20/7/24

SA_DQ đã viết:

Bạn thử với con rùa bò này xem đúng ý bạn chưa?

PHP:

Sub SapXepTheoMau()     'FIND() '
 Dim Rws As Long, W As Integer, Dng As Integer
 Dim Rng As Range, sRng As Range, Cls As Range
 Dim MyAdd As String
 
 Dng = [B3].CurrentRegion.Rows.Count
 Rws = [K3].CurrentRegion.Rows.Count
 ReDim Arr(1 To (Dng + Rws + 9), 1 To 2)
 [H3].Resize(Dng + Rws + 9, 2).Value = Arr()    'Xóa Du Liêu Lân Truóc  '
 Set Rng = [K2].Resize(Rws)
 For Each Cls In Range([B3], [B3].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        W = W + 1
        MyAdd = sRng.Address
        Do
            Arr(W, 1) = sRng.Value:         Arr(W, 2) = sRng.Offset(, 1).Value
            W = W + 1
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next Cls
 [H3].Resize(W, 2).Value = Arr()
End Sub[/php
[/QUOTE]

SA_DQ đã viết:

Bạn thử với con rùa bò này xem đúng ý bạn chưa?

PHP:

Sub SapXepTheoMau()     'FIND() '
 Dim Rws As Long, W As Integer, Dng As Integer
 Dim Rng As Range, sRng As Range, Cls As Range
 Dim MyAdd As String
 
 Dng = [B3].CurrentRegion.Rows.Count
 Rws = [K3].CurrentRegion.Rows.Count
 ReDim Arr(1 To (Dng + Rws + 9), 1 To 2)
 [H3].Resize(Dng + Rws + 9, 2).Value = Arr()    'Xóa Du Liêu Lân Truóc  '
 Set Rng = [K2].Resize(Rws)
 For Each Cls In Range([B3], [B3].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        W = W + 1
        MyAdd = sRng.Address
        Do
            Arr(W, 1) = sRng.Value:         Arr(W, 2) = sRng.Offset(, 1).Value
            W = W + 1
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next Cls
 [H3].Resize(W, 2).Value = Arr()
End Sub

Anh Chị ơi cho em hỏi thêm chút ạ.Nếu không muốn có cái hàng trống ở giữa thì code phải sửa như thế nào ạ ?

SA_DQ · 20/7/24

Ở trong macro có 2 dòng lệnh giống nhau về thêm đơn vị cho tham biến W;
Muốn không còn dòng trống thì trãi qua 2 bước sửa như sau
:→ Vô hiệu hóa dòng lệnh trên;
→ Đem dòng lệnh sau (dưới) lên dưới ngay dòng lệnh

Mã:

Do

Chúc bạn thành công!

Thùy Anh 96 · 20/7/24

SA_DQ đã viết:
Ở trong macro có 2 dòng lệnh giống nhau về thêm đơn vị cho tham biến W;
Muốn không còn dòng trống thì trãi qua 2 bước sửa như sau
:→ Vô hiệu hóa dòng lệnh trên;
→ Đem dòng lệnh sau (dưới) lên dưới ngay dòng lệnh

Mã:

Do

Chúc bạn thành công!

Thanks bác. Em lm được rồi ạ

Sắp xếp data theo dựa theo bảng cho sẵn. (1 người xem)

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

Thùy Anh 96

Thành viên mới

File đính kèm

Phuocam

Thành viên mới

Thùy Anh 96

Thành viên mới

SA_DQ

/(hông là gì!

longtay1111

Thành viên hoạt động

File đính kèm

Thùy Anh 96

Thành viên mới

Thùy Anh 96

Thành viên mới

SA_DQ

/(hông là gì!

Thùy Anh 96

Thành viên mới

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

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