Sắp xếp data theo dựa theo bảng cho sẵn.

[Thùy Anh 96]

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]

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]

.
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]

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

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]

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]

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

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

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]

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

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]

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

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]

Ở 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

 Do

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

 

[Thùy Anh 96]

Ở 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

 Do

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

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