sắp xếp dữ liệu (sort)

[thuyyeu99]

Nhờ các anh chị trong GPE hướng dẫn cách sort dữ liệu mà trong bảng tính có những ô bị trộn Merge and center

 

[SA_DQ]

Trộn ô có đẹp thật, nhưng khó găm vô chừng!

Nhờ các anh chị trong GPE hướng dẫn cách sort dữ liệu mà trong bảng tính có những ô bị trộn Merge and center

Ví dụ ta đang có trang tính như sau:

H | I | J
DiaChi|QH|HTen
|CH|Vo An
01 Le Duan|Ch|A Sang
|V| Tran Anh
52 Le Loi|CH|V. Hong
|C|Le My
02 Le Lai|CH|Le Anh
|V|Do Thy

Khi chạy macro sau:

Option Explicit
Sub SortMerge()
 Dim eRw As Long, jJ As Long
 Dim mRng As Range:                         Dim StrC As String
 
 eRw = [I65500].End(xlUp).Row:              Columns("I:I").Select
 Selection.Insert Shift:=xlToRight::        [I1].Value = [h1].Value
 For jJ = 2 To eRw
    With Cells(jJ, "H")
        If .MergeCells Then
            If .Value <> "" And StrC <> .Value Then _
                StrC = .Value
            .Offset(, 1).Value = StrC
        Else
            .Offset(, 1).Value = .Value:    StrC = ""
        End If
    End With
 Next jJ
 StrC = "":          Application.DisplayAlerts = False
 For jJ = 2 To eRw
    With Cells(jJ, "I")
        If .Value <> StrC And mRng Is Nothing Then
            StrC = .Value:                      Set mRng = .Cells()
        ElseIf .Value = StrC And Not mRng Is Nothing Then
            Set mRng = Union(mRng, .Cells())
        ElseIf .Value <> StrC And Not mRng Is Nothing Then
            mRng.MergeCells = True
            If .Value = .Offset(1).Value Then
                Set mRng = .Cells()
            Else
                Set mRng = Nothing
            End If
        End If
    End With
 Next jJ
 Columns("H:H").Delete Shift:=xlToLeft
  Application.DisplayAlerts = True
End Sub

Ta có kết quả thể hiện ở bảng sau:

H | I | J
DiaChi|QH|HTen
|CH|Vo An
01 Le Duan|Ch|A Sang
|V| Tran Anh
52 Le Loi|CH|V. Hong
02 Le Lai|C|Le My
02 Le Lai|CH|Le Anh
02 Le Lai|V|Do Thy

(Có nghĩa là chưa trộn lại các ô dữ liệu 1 cách hoàn toàn! Tạm làm bằng tay vậy bạn nha, trong khi chờ đợi sự trợ giúp tiếp theo, nếu có!)

 

[phamduylong]

Nhờ các anh chị trong GPE hướng dẫn cách sort dữ liệu mà trong bảng tính có những ô bị trộn Merge and center

Theo tôi, bạn không nên sort khi dữ liệu có Merge and center (cho dù bạn can thiệp tự động bằng VBA hay Excel chấp nhận sort) vì mối quan hệ dữ liệu không được tổ chức dạng bảng dữ liệu (1 dòng là 1 mẫu tin, 1 cột là 1 loại dữ liệu) nên sau khi sort dữ liệu dễ bị mất mối quan hệ dòng, cột.
Bạn nên hủy Merge and center, kiểm tra, chỉnh lại bằng tay bảng dữ liệu trước khi sort.
Trong trường hợp dữ liệu quá nhiều, không thể kiểm tra bằng tay được thì các ô Merge and center phải theo 1 quy luật. Từ quy luật đó, có thể dùng VBA để sort.

 

[SA_DQ]

Chỉ cần thêm 1 trong câu lệnh là xong

Ví dụ ta đang có trang tính như sau:

H | I | J
DiaChi|QH|HTen
|CH|Vo An
01 Le Duan|Ch|A Sang
|V| Tran Anh
52 Le Loi|CH|V. Hong
|C|Le My
02 Le Lai|CH|Le Anh
|V|Do Thy

Khi chạy macro sau:

Option Explicit
Sub SortMerge()
 Dim eRw As Long, jJ As Long
 Dim mRng As Range:                         Dim StrC As String
 
 eRw = [I65500].End(xlUp).Row:              Columns("I:I").Select
 Selection.Insert Shift:=xlToRight::        [I1].Value = [h1].Value
 For jJ = 2 To eRw +1 '<=|'
    With Cells(jJ, "H")
        If .MergeCells Then
            If .Value <> "" And StrC <> .Value Then _
                StrC = .Value
            .Offset(, 1).Value = StrC
        Else
            .Offset(, 1).Value = .Value:    StrC = ""
        End If
    End With
 Next jJ
 StrC = "":          Application.DisplayAlerts = False
 For jJ = 2 To eRw
    With Cells(jJ, "I")
        If .Value <> StrC And mRng Is Nothing Then
            StrC = .Value:                      Set mRng = .Cells()
        ElseIf .Value = StrC And Not mRng Is Nothing Then
            Set mRng = Union(mRng, .Cells())
        ElseIf .Value <> StrC And Not mRng Is Nothing Then
            mRng.MergeCells = True
            If .Value = .Offset(1).Value Then
                Set mRng = .Cells()
            Else
                Set mRng = Nothing
            End If
        End If
    End With
 Next jJ
 Columns("H:H").Delete Shift:=xlToLeft
  Application.DisplayAlerts = True
End Sub

Ta có kết quả thể hiện ở bảng sau:

H | I | J
DiaChi|QH|HTen
|CH|Vo An
01 Le Duan|Ch|A Sang
|V| Tran Anh
52 Le Loi|CH|V. Hong
|C|Le My
02 Le Lai|CH|Le Anh
|V|Do Thy

Mình đã tìm cách & sửa lại câu lệnh là được; Nhưng mấy hôm nay quên bẵng đí đó!
Cảm ơn thầy Long đã đề ập lại vấn đề.