Format wrap text và chiều cao của ô phù hợp với dữ liệu trong ô bằng VBA

[selves037]

Chào mọi người như chủ đề của bài đăng e có 1 ô có nội dung thay đổi khi thì nhiều chữ, khi thì ít chữ được Merger cell từ A8:H8 em muốn nhờ mọi người đoạn code VBA để format ô đó tự động xuống dòng (wap text) và chiều cao (height row) của ô cũng thay đổi phù hợp với dữ liệu của ô đó, em muốn sau khi format nó sẽ hiện thị như ô A12:H12 như trong hình ảnh. E có thử làm bằng cách ghi Macro nhưng vẫn chưa được. E mong mọi người giúp đỡ, em cảm ơn !!!

 

[Nhattanktnn]

Chào mọi người như chủ đề của bài đăng e có 1 ô có nội dung thay đổi khi thì nhiều chữ, khi thì ít chữ được Merger cell từ A8:H8 em muốn nhờ mọi người đoạn code VBA để format ô đó tự động xuống dòng (wap text) và chiều cao (height row) của ô cũng thay đổi phù hợp với dữ liệu của ô đó, em muốn sau khi format nó sẽ hiện thị như ô A12:H12 như trong hình ảnh. E có thử làm bằng cách ghi Macro nhưng vẫn chưa được. E mong mọi người giúp đỡ, em cảm ơn !!!
View attachment 252245

cho cái file dữ liệu thật xem nào bạn

 

[Maika8008]

Vụ này nếu đơn giản thì dùng cột phụ có độ rộng bằng tổng độ rộng của các cột A đến H để chứa nội dung giống hệt thế. Lúc đó AutoFit bằng VBA mới có tác dụng

 

[befaint]

Khá phức tạp đấy. Như bài này này.

Xin hỗ trợ code - mở rộng dòng theo tùy biến

Tôi có sử dụng code AutoFit dòng (Có trộn dòng). Khi cho chạy code thì : - Dòng chỉ mở tối đa được Row Hei ght = 45 mà thôi. Ví dụ như File đính kèm chạy thử dòng 48 thì thấy rõ Xin các bạn hỗ trợ biện pháp xử lý cho code chạy tùy biến khi dữ liệu trong vùng đó tăng giảm tùy chọn - Xin trân...

www.giaiphapexcel.com

 

[selves037]

cho cái file dữ liệu thật xem nào bạn

Đây nhé b, file đơn giản thôi chỉ có 2 ô, mình muốn có đoạn VBA format ô đầu tiên nó ra thành ô thứ 2

 

[Nhattanktnn]

Đây nhé b, file đơn giản thôi chỉ có 2 ô, mình muốn có đoạn VBA format ô đầu tiên nó ra thành ô thứ 2

Bạn thử code này nhé, hơi muộn rồi nên không biết có lú đoạn nào không

Sub NTKTNN()
Dim MergeWidth As Single, oWidth As Double, NewRowHt As Double
Dim subRng As Range, AutoFitRng As Range, Cll As Range, Rng As Range
Application.ScreenUpdating = False
Set Rng = Range("A1:A15") 'Chon vung can xu ly
For Each Cll In Rng
    If Cll <> "" And Cll.MergeCells Then
        Set AutoFitRng = Cll.MergeArea
        With AutoFitRng
          .MergeCells = False
          oWidth = .Cells(1).ColumnWidth
          MergeWidth = 0
          For Each subRng In AutoFitRng
              MergeWidth = subRng.ColumnWidth + MergeWidth
          Next
          MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
          .Cells(1).ColumnWidth = MergeWidth
          Cll.WrapText = True
          .EntireRow.AutoFit
          NewRowHt = .RowHeight
          .Cells(1).ColumnWidth = oWidth
          .MergeCells = True
          .RowHeight = NewRowHt
        End With
    End If
Next
Application.ScreenUpdating = True
End Sub

 

[selves037]

Bạn thử code này nhé, hơi muộn rồi nên không biết có lú đoạn nào không

Sub NTKTNN()
Dim MergeWidth As Single, oWidth As Double, NewRowHt As Double
Dim subRng As Range, AutoFitRng As Range, Cll As Range, Rng As Range
Application.ScreenUpdating = False
Set Rng = Range("A1:A15") 'Chon vung can xu ly
For Each Cll In Rng
    If Cll <> "" And Cll.MergeCells Then
        Set AutoFitRng = Cll.MergeArea
        With AutoFitRng
          .MergeCells = False
          oWidth = .Cells(1).ColumnWidth
          MergeWidth = 0
          For Each subRng In AutoFitRng
              MergeWidth = subRng.ColumnWidth + MergeWidth
          Next
          MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
          .Cells(1).ColumnWidth = MergeWidth
          Cll.WrapText = True
          .EntireRow.AutoFit
          NewRowHt = .RowHeight
          .Cells(1).ColumnWidth = oWidth
          .MergeCells = True
          .RowHeight = NewRowHt
        End With
    End If
Next
Application.ScreenUpdating = True
End Sub

Cám ơn bạn nhiều, cho mình hỏi chút nếu bây giờ mình muốn set vùng xư lý nhiều ô đơn lẻ thì ntn ạ, ví dụ trong cả bảng tính mình muốn set cho các ô sheet1.[A1], sheet5.[B3], sheet7.[c2] thì dòng Set Rng sẽ viết lại thành như thế nào để Rng nó hiểu là là mảng range ạ

 

[Hoàng Tuấn 868]

Merger cell từ A8:H8, tự động xuống dòng (wap text) và chiều cao (height row) của ô cũng thay đổi phù hợp với dữ liệu của ô đó.

Bạn tham khảo.........

 

[Maika8008]

Cám ơn bạn nhiều, cho mình hỏi chút nếu bây giờ mình muốn set vùng xư lý nhiều ô đơn lẻ thì ntn ạ, ví dụ trong cả bảng tính mình muốn set cho các ô sheet1.[A1], sheet5.[B3], sheet7.[c2] thì dòng Set Rng sẽ viết lại thành như thế nào để Rng nó hiểu là là mảng range ạ

Set Rng = Union(range1, range2,...)

 

[Nhattanktnn]

Set Rng = Union(range1, range2,...)

Union không dùng cho các sheet khác nhau được bác ạ

 

[Maika8008]

Union không dùng cho các sheet khác nhau được bác ạ

À nhỉ! Vụ này ít dùng nên bị lủng.

 

[HeSanbi]

@Nhattanktnn​

@Hoàng Tuấn 868​

Hai bác code như vậy sẽ phá hỏng cấu trúc trong trang tính của người ta đấy
Bình tĩnh suy nghĩ các lỗi có thể xảy ra trước khi chia sẻ code.
Đơn giản nếu ô có Merge hai ô khác dòng liền kề là lỗi.
Và nếu có xảy ra lỗi thì trả lại cấu trúc ban đầu cho người ta.
Code giản dòng không đơn giản như vậy đâu các bác.

Thử nghĩ thêm giải thuật.
Ví dụ chép ô cần định dạng sang một ô mượn, rồi tính toán xong, trả lại kết quả, và trả định dạng ban đầu cho ô mượn.
Nếu tôi muốn định dạng chiều cao hai ô đã Merge ngang hàng tổng dòng khác nhau thì phải làm sao?
Nếu ô đã Merge nằm trong Vùng đã được Ngăn để In Ấn thì phải làm sao?

 

[befaint]

MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66

Thấy số o.66 là hơi nghi ngờ đó.
Bạn thử thay đổi font style, font size các kiểu xem.
Giải thuật hiện tại hợp lý nhất như ở link mình gửi ở bài #4 ấy.
Có một addins ông tây trên github, nhưng khá rườm rà và kết quả một số trường hợp vẫn không ngon bằng giải thuật của mình.

Diễn đàn là nơi trao đổi, vậy nên sai hay đúng, tốt hay chưa tốt, nhanh hay vội oằn là tà vằn gì đó thì ta hoàn toàn có quyền tuyệt đối úp lên đây để cùng tham gia giúp đỡ, trao đổi, học tập. Không có lý do gì sứt mà phãi hoán nại (viết ngọng vậy mới đúng nhịp điệu).

 

[VetMini]

... Không có lý do gì sứt mà phãi hoán nại (viết ngọng vậy mới đúng nhịp điệu).

Có. Bạn thử gú gô từ khoá "narcissist"

 

[selves037]

Bạn tham khảo.........

Bạn tham khảo....

Bạn ơi bạn Dùng Add in hay Macro mà mình ấn Atl + F11 sao không thấy đoạn code đó thế

 

[Hoàng Tuấn 868]

Bạn ơi bạn Dùng Add in hay Macro mà mình ấn Atl + F11 sao không thấy đoạn code đó thế

Mình viết bình thường mà, có gì khác đâu. File không dùng được hay sao hả bạn.

 

[selves037]

Mình viết bình thường mà, có gì khác đâu. File không dùng được hay sao hả bạn.

Không hiểu sao cái đoạn code của bạn khi ốp vào bảng tính của mình thì nó hoạt động không đúng, bạn thử kiểm tra xem có lỗi liên quan đến bề rộng của ô không nhé, bảng tính của mình có độ rộng nhỏ: 0.63 , bạn kiểm tra trong đính kèm và hỗ trợ dùm mình với nhé, thanks bạn !!!

 

[Hoàng Tuấn 868]

Không hiểu sao cái đoạn code của bạn khi ốp vào bảng tính của mình thì nó hoạt động không đúng, bạn thử kiểm tra xem có lỗi liên quan đến bề rộng của ô không nhé, bảng tính của mình có độ rộng nhỏ: 0.63 , bạn kiểm tra trong đính kèm và hỗ trợ dùm mình với nhé, thanks bạn !!!

Bạn điều chỉnh chưa đúng.
Thử lại file dưới đây. (Nếu cảm ơn bằng tiếng Việt thì vui hơn)