Tự động Merge Cell theo điều kiện

[TrungChinhs]

Chào các bạn ! mình muốn viết một sub để tự động Merge Cell tại một cột theo điều kiện là số dòng có dữ liệu tại một cột khác (ví dụ trong File đính kèm) nhưng chưa tìm ra cách. Bạn nào biết viết giúp mình hoặc gợi ý cho mình cách làm. Xin cảm ơn !

 

[hoangvuluan]

Bạn dùng thử 2 macro dưới đây. Tùy trường hợp để dùng. Nếu cột chứa dữ liệu thì dùng M1, ngược lại, nếu cột chứa công thức thì dùng M2.

Sub MergeCell1()
    Dim rngI As Range
    Dim rngO As Range
    Dim oCol As Integer
    On Error GoTo 1
    With Application
        .ScreenUpdating = False
        Set rngI = .InputBox(prompt:="Chon cot chua du lieu de xet: ", Type:=8)
        Set rngO = .InputBox(prompt:="Chon cot chua vung de tron o: ", Type:=8)
        oCol = rngO.Column - rngI.Column
        Set rngI = rngI(1, 1).EntireColumn
        Set rngI = rngI.SpecialCells(Type:=xlCellTypeConstants)
        For Each rngO In rngI.Areas
            rngO.Offset(, oCol).Merge
        Next
1:
        .ScreenUpdating = True
    End With
End Sub
Sub MergeCell2()
    Dim rngI As Range
    Dim rngO As Range
    Dim oCol As Integer
    On Error GoTo 1
    With Application
        .ScreenUpdating = False
        Set rngI = .InputBox(prompt:="Chon cot chua du lieu de xet: ", Type:=8)
        Set rngO = .InputBox(prompt:="Chon cot chua vung de tron o: ", Type:=8)
        oCol = rngO.Column - rngI.Column
        Set rngI = rngI(1, 1).EntireColumn
        Set rngI = rngI.SpecialCells(Type:=xlCellTypeFormulas)
        For Each rngO In rngI.Areas
            rngO.Offset(, oCol).Merge
        Next
1:
        .ScreenUpdating = True
    End With
End Sub

 

[TrungChinhs]

Cảm ơn HoangVuLuan ! Mình đã chạy thử kết quả rất tốt.

Chúc bạn và gia đình năm mới mạnh khỏe, hạnh phúc.

 

[NguyenNgocSon]

bạn xem code sau và sửa cho đúng ý bạn
Mình chỉ hướng dẫn thôi
có gì trao đổi sau

Sub Merge_NgocSon()
Dim UserRange As Range
Dim DefaultRange As String
DefaultRange = Selection.Address
On Error GoTo Canceled
Set UserRange = Application.InputBox("Vung can lam viec:", "Tron cac vung", DefaultRange, , , , , 8)
UserRange.Merge
Application.Dialogs(xlDialogAlignment).Show
UserRange.Select
Canceled:
End Sub

 

[ndu96081631]

Ôi... bài này nhơ không lầm tôi đã làm rất nhiều lần
Mấu chốt ở đây là SpecialCells(4) các bạn à
Tôi lấy ví dụ với dử liệu của bạn Trung Chinh nhé

Sub Test()
  With Range("B3").CurrentRegion.Resize(, 1).SpecialCells(4)
    For i = 1 To .Areas.Count
      .Areas(i).Offset(, 2).Merge
    Next
  End With
End Sub

 

[boyxin]

@ndu96081631: sao không là thế này cho gọn mà lại dùng For ... Next ?

Sub Test()
  With Range("B3").CurrentRegion.Resize(, 1).SpecialCells(4)
    .Offset(, 2).Merge
  End With
End Sub

Hoặc có thể bỏ With...End With vì câu lệnh cũng không dài lắm

Sub Test()
  Range("B3").CurrentRegion.Resize(, 1).SpecialCells(4).Offset(, 2).Merge
End Sub

 

[ndu96081631]

@ndu96081631: sao không là thế này cho gọn mà lại dùng For ... Next ?

Sub Test()
  With Range("B3").CurrentRegion.Resize(, 1).SpecialCells(4)
    .Offset(, 2).Merge
  End With
End Sub

Hoặc có thể bỏ With...End With vì câu lệnh cũng không dài lắm

Sub Test()
  Range("B3").CurrentRegion.Resize(, 1).SpecialCells(4).Offset(, 2).Merge
End Sub

Uh nhỉ---> Quên để ý rằng Merge có khả năng làm việc xuyên qua các Areas

 

[tuoigiyeuem]

Nhờ các ACE giúp hộ em Merge Cells theo điều kiện : Xét ở cột B, nếu những ô gần nhau có giá trị giống nhau thì merge những ô đó lại.
Em xin cám ơn !

 

[VetMini]

Nhờ các ACE giúp hộ em Merge Cells theo điều kiện : Xét ở cột B, nếu những ô gần nhau có giá trị giống nhau thì merge những ô đó lại.
Em xin cám ơn !

Bạn có để ý là thớt này đã cách đây gàn 8 năm không?

Lúc đó mọi người (*) ở đây chỉ chuyên luyện code cho nên không màng đến việc merge cells là điều không thích hợp với code. Thực hiện thì không khó nhưng kết quả thuộc loại nguy hiểm, khó xác định độ tin cậy (đối với dữ liệu quản lý, không xác định được độ tin cậy là dữ liệu bỏ đi)

(*) xin lỗi những người có dự vào thớt bày. Lời tôi nói thẳng.

 

[tuoigiyeuem]

Bạn có để ý là thớt này đã cách đây gàn 8 năm không?

Lúc đó mọi người (*) ở đây chỉ chuyên luyện code cho nên không màng đến việc merge cells là điều không thích hợp với code. Thực hiện thì không khó nhưng kết quả thuộc loại nguy hiểm, khó xác định độ tin cậy (đối với dữ liệu quản lý, không xác định được độ tin cậy là dữ liệu bỏ đi)

(*) xin lỗi những người có dự vào thớt bày. Lời tôi nói thẳng.

Xin lỗi anh, thớt này 8 năm chứ 10 hay 15 năm thì em cần mà em không biết về code nên em muốn hỏi. Còn việc quản lý dữ liệu thì cũng chả ai Merge Cell để quản lý dữ liệu anh ạ. 1 số công việc yêu cầu bảng biểu Merge để khi in ra nhìn cho dễ xem.

 

[Phantan7211]

Nhờ các ACE giúp hộ em Merge Cells theo điều kiện : Xét ở cột B, nếu những ô gần nhau có giá trị giống nhau thì merge những ô đó lại.
Em xin cám ơn !

em có cùng câu hỏi giống anh này xin các thầy trên diễn đàn giúp với. em xin cảm ơn!

 

[Hungdk1980]

Uh nhỉ---> Quên để ý rằng Merge có khả năng làm việc xuyên qua các Areas

Bác có thể giải thích được cho em chút được không ?

 

[duc nguyen 1205555]

Nhờ các ACE giúp hộ em Merge Cells theo điều kiện : Xét ở cột B, nếu những ô gần nhau có giá trị giống nhau thì merge những ô đó lại.
Em xin cám ơn !

em có cùng câu hỏi giống anh này xin các thầy trên diễn đàn giúp với. em xin cảm ơn!

 

[nammkn02]

Sao nội dung này ko thấy ai trả lời cả. Có bạn nào hỗ trợ với ko ạ

 

[nammkn02]

Nhờ các anh chị giúp mình vấn đề về merge & center tự xếp các hàng giống nhau