Bỏ qua nội dung chính

Làm cách nào để tự động điều chỉnh chiều cao hàng của các ô đã hợp nhất trong Excel?

Trong Excel, chúng tôi có thể nhanh chóng điều chỉnh chiều cao hàng để vừa với nội dung ô bằng cách sử dụng AutoFit Row Height nhưng chức năng này sẽ hoàn toàn bỏ qua các ô đã hợp nhất. Có nghĩa là, bạn không thể áp dụng AutoFit Row Height tính năng thay đổi kích thước chiều cao hàng của các ô đã hợp nhất, bạn cần phải điều chỉnh thủ công chiều cao hàng cho từng ô đã hợp nhất. Trong bài viết này, tôi có thể giới thiệu một số phương pháp nhanh chóng để giải quyết vấn đề này.

Tự động điều chỉnh chiều cao hàng của các ô đã hợp nhất với mã VBA


mũi tên màu xanh bong bóng bên phải Tự động điều chỉnh chiều cao hàng của các ô đã hợp nhất với mã VBA

Giả sử tôi có một trang tính với một số ô đã hợp nhất như hình minh họa sau và bây giờ tôi cần thay đổi kích thước chiều cao hàng ô để hiển thị toàn bộ nội dung, mã VBA dưới đây có thể giúp bạn tự động điều chỉnh chiều cao hàng của nhiều ô đã hợp nhất, vui lòng thực hiện như sau:

doc-autofit-merge-cells-1

1. Giữ ALT + F11 chìa khóa và nó mở Cửa sổ Microsoft Visual Basic for Applications.

2. Nhấp chuột Chèn > Mô-đunvà dán mã sau vào Cửa sổ mô-đun.

Mã VBA: Tự động điều chỉnh chiều cao hàng của nhiều ô được hợp nhất
Option Explicit
Public Sub AutoFitAll()
  Call AutoFitMergedCells(Range("a1:b2"))
   Call AutoFitMergedCells(Range("c4:d6"))
    Call AutoFitMergedCells(Range("e1:e3"))
End Sub
Public Sub AutoFitMergedCells(oRange As Range)
  Dim tHeight As Integer
  Dim iPtr As Integer
  Dim oldWidth As Single
  Dim oldZZWidth As Single
  Dim newWidth As Single
  Dim newHeight As Single
  With Sheets("Sheet4")
    oldWidth = 0
    For iPtr = 1 To oRange.Columns.Count
      oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
    Next iPtr
    oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth
    oRange.MergeCells = False
    newWidth = Len(.Cells(oRange.Row, oRange.Column).Value)
    oldZZWidth = .Range("ZZ1").ColumnWidth
    .Range("ZZ1") = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
    .Range("ZZ1").WrapText = True
    .Columns("ZZ").ColumnWidth = oldWidth
    .Rows("1").EntireRow.AutoFit
    newHeight = .Rows("1").RowHeight / oRange.Rows.Count
    .Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
    oRange.MergeCells = True
    oRange.WrapText = True
    .Range("ZZ1").ClearContents
    .Range("ZZ1").ColumnWidth = oldZZWidth
  End With
End Sub

Ghi chú:

(1.) Trong đoạn mã trên, bạn có thể thêm các phạm vi mới chỉ cần sao chép Gọi AutoFitMergedCells (Phạm vi ("a1: b2")) tập lệnh nhiều lần tùy thích và thay đổi các phạm vi ô đã hợp nhất theo nhu cầu của bạn.

(2.) Và bạn nên thay đổi tên trang tính hiện tại Sheet4 đến tên trang tính đã sử dụng của bạn.

3. Sau đó nhấn F5 để chạy mã này và bây giờ, bạn có thể thấy tất cả các ô được hợp nhất đã được tự động điều chỉnh nội dung ô của chúng, xem ảnh chụp màn hình:

doc-autofit-merge-cells-1


Bài viết liên quan:

Làm thế nào để tự động điều chỉnh chiều rộng cột trong Excel?

Công cụ năng suất văn phòng tốt nhất

🤖 Trợ lý AI của Kutools: Cách mạng hóa việc phân tích dữ liệu dựa trên: Thực thi thông minh   |  Tạo mã  |  Tạo công thức tùy chỉnh  |  Phân tích dữ liệu và tạo biểu đồ  |  Gọi các hàm Kutools...
Các tính năng phổ biến: Tìm, đánh dấu hoặc xác định các bản sao   |  Xóa hàng trống   |  Kết hợp các cột hoặc ô mà không làm mất dữ liệu   |   Vòng không có công thức hữu ích. Cảm ơn !
Siêu tra cứu: Nhiều tiêu chí VLookup    VLookup Nhiều Giá Trị  |   VLookup trên nhiều trang tính   |   Tra cứu mờ ....
Danh sách thả xuống nâng cao: Tạo nhanh danh sách thả xuống   |  Danh sách thả xuống phụ thuộc   |  Danh sách thả xuống nhiều lựa chọn ....
Trình quản lý cột: Thêm một số cột cụ thể  |  Di chuyển cột  |  Chuyển đổi trạng thái hiển thị của các cột ẩn  |  So sánh dãy và cột hữu ích. Cảm ơn !
Các tính năng nổi bật: Tiêu điểm lưới   |  Chế độ xem thiết kế   |   Thanh công thức lớn    Trình quản lý sổ làm việc & trang tính   |  Thư viện tài nguyên (Văn bản tự động)   |  Bảng chọn ngày   |  Kết hợp các bảng tính   |  Mã hóa/Giải mã ô    Gửi email theo danh sách   |  Siêu lọc   |   Bộ lọc đặc biệt (lọc in đậm/nghiêng/gạch ngang...) ...
15 bộ công cụ hàng đầu12 bản văn CÔNG CỤ (thêm văn bản, Xóa ký tự,...)   |   50 + Biểu đồ Các loại (Biểu đồ Gantt,...)   |   40+ Thực tế Công thức (Tính tuổi dựa trên ngày sinh,...)   |   19 chèn CÔNG CỤ (Chèn mã QR, Chèn ảnh từ đường dẫn,...)   |   12 Chuyển đổi CÔNG CỤ (Số thành từ, Chuyển đổi tiền tệ,...)   |   7 Hợp nhất & Tách CÔNG CỤ (Các hàng kết hợp nâng cao, Chia ô,...)   |   ... và nhiều hơn nữa

Nâng cao kỹ năng Excel của bạn với Kutools for Excel và trải nghiệm hiệu quả hơn bao giờ hết. Kutools for Excel cung cấp hơn 300 tính năng nâng cao để tăng năng suất và tiết kiệm thời gian.  Bấm vào đây để có được tính năng bạn cần nhất...

Mô tả


Tab Office mang lại giao diện Tab cho Office và giúp công việc của bạn trở nên dễ dàng hơn nhiều

  • Cho phép chỉnh sửa và đọc theo thẻ trong Word, Excel, PowerPoint, Publisher, Access, Visio và Project.
  • Mở và tạo nhiều tài liệu trong các tab mới của cùng một cửa sổ, thay vì trong các cửa sổ mới.
  • Tăng 50% năng suất của bạn và giảm hàng trăm cú nhấp chuột cho bạn mỗi ngày!

<p >

Công cụ năng suất văn phòng tốt nhất

🤖 Trợ lý AI của Kutools: Cách mạng hóa việc phân tích dữ liệu dựa trên: Thực thi thông minh   |  Tạo mã  |  Tạo công thức tùy chỉnh  |  Phân tích dữ liệu và tạo biểu đồ  |  Gọi các hàm Kutools...
Các tính năng phổ biến: Tìm, đánh dấu hoặc xác định các bản sao   |  Xóa hàng trống   |  Kết hợp các cột hoặc ô mà không làm mất dữ liệu   |   Vòng không có công thức hữu ích. Cảm ơn !
Siêu tra cứu: Nhiều tiêu chí VLookup    VLookup Nhiều Giá Trị  |   VLookup trên nhiều trang tính   |   Tra cứu mờ ....
Danh sách thả xuống nâng cao: Tạo nhanh danh sách thả xuống   |  Danh sách thả xuống phụ thuộc   |  Danh sách thả xuống nhiều lựa chọn ....
Trình quản lý cột: Thêm một số cột cụ thể  |  Di chuyển cột  |  Chuyển đổi trạng thái hiển thị của các cột ẩn  |  So sánh dãy và cột hữu ích. Cảm ơn !
Các tính năng nổi bật: Tiêu điểm lưới   |  Chế độ xem thiết kế   |   Thanh công thức lớn    Trình quản lý sổ làm việc & trang tính   |  Thư viện tài nguyên (Văn bản tự động)   |  Bảng chọn ngày   |  Kết hợp các bảng tính   |  Mã hóa/Giải mã ô    Gửi email theo danh sách   |  Siêu lọc   |   Bộ lọc đặc biệt (lọc in đậm/nghiêng/gạch ngang...) ...
15 bộ công cụ hàng đầu12 bản văn CÔNG CỤ (thêm văn bản, Xóa ký tự,...)   |   50 + Biểu đồ Các loại (Biểu đồ Gantt,...)   |   40+ Thực tế Công thức (Tính tuổi dựa trên ngày sinh,...)   |   19 chèn CÔNG CỤ (Chèn mã QR, Chèn ảnh từ đường dẫn,...)   |   12 Chuyển đổi CÔNG CỤ (Số thành từ, Chuyển đổi tiền tệ,...)   |   7 Hợp nhất & Tách CÔNG CỤ (Các hàng kết hợp nâng cao, Chia ô,...)   |   ... và nhiều hơn nữa

Nâng cao kỹ năng Excel của bạn với Kutools for Excel và trải nghiệm hiệu quả hơn bao giờ hết. Kutools for Excel cung cấp hơn 300 tính năng nâng cao để tăng năng suất và tiết kiệm thời gian.  Bấm vào đây để có được tính năng bạn cần nhất...

Mô tả


Tab Office mang lại giao diện Tab cho Office và giúp công việc của bạn trở nên dễ dàng hơn nhiều

  • Cho phép chỉnh sửa và đọc theo thẻ trong Word, Excel, PowerPoint, Publisher, Access, Visio và Project.
  • Mở và tạo nhiều tài liệu trong các tab mới của cùng một cửa sổ, thay vì trong các cửa sổ mới.
  • Tăng 50% năng suất của bạn và giảm hàng trăm cú nhấp chuột cho bạn mỗi ngày!
</ p >

Comments (28)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Perfect, good job! A just not ajust with merge cells in the same colum, there is an error with this code on the script:

For exemple if i want ajust this range ("a32:i32"):

Call AutoFitMergedCells(Range("a32:i32"))

Apear an error in this line of the script:

.Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight

Could you help me?
This comment was minimized by the moderator on the site
Hi All,

I modify the codes, which will search the merged cells and apply the autofit. hope this will help the future if any one interested.


Sub FindMergedCells()

' Declare sheet you want to look for merged cells on - in the example it's sheet 1
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets(1)
Dim rng As Range
Dim rngStart As Range
Dim rngEnd As Range
Dim tHeight As Integer
Dim iPtr As Integer
Dim oldWidth As Double
Dim oldZZWidth As Double
Dim newWidth As Double
Dim newHeight As Double
Dim oRange As Range


' Add sheet for output
Dim output As Worksheet
Set output = Sheets.Add(after:=Sheets(1))

' Initialize row counter for output
orow = 0

' Header on output sheet


' Check all the cells in the worksheet's used range
For Each cell In sheet.UsedRange

' If they're merged -

If cell.MergeCells Then
orow = orow + 1
Set cell = cell.MergeArea
Set rngStart = cell.Cells(1, 1)
Set rngEnd = cell.Cells(cell.Rows.Count, cell.Columns.Count)

'MsgBox "First Cell " & rngStart.Address & vbNewLine & "Last Cell " & rngEnd.Address
'output.Cells(orow, 1) = "" & Replace(rngStart.Address, "$", "") & ":" & Replace(rngEnd.Address, "$", "")
Set oRange = Range("" & Replace(rngStart.Address, "$", "") & ":" & Replace(rngEnd.Address, "$", ""))

With sheet
oldWidth = 0
For iPtr = 1 To oRange.Columns.Count
oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
Next iPtr
'oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth
oRange.MergeCells = False
newWidth = Len(.Cells(oRange.Row, oRange.Column).Value)
oldZZWidth = .Range("ZZ1").ColumnWidth
.Range("ZZ1") = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
.Range("ZZ1").WrapText = True
.Columns("ZZ").ColumnWidth = oldWidth
.Rows("1").EntireRow.AutoFit
newHeight = .Rows("1").RowHeight / oRange.Rows.Count
.Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
oRange.MergeCells = True
oRange.WrapText = True
.Range("ZZ1").ClearContents
.Range("ZZ1").ColumnWidth = oldZZWidth
End With
Else

'MsgBox "Not merged area"

End If
Next cell

End Sub
This comment was minimized by the moderator on the site
I have tried this as I am not at all proficient with VBA. At the "Set Sheet = Activeworkbook I always get this Compile Error - Invalid outside procedure. What am I doing wrong?
This comment was minimized by the moderator on the site
Works perfectly on a single sheet. I need to fit multiple worksheet cells in one file. can you help me?
This comment was minimized by the moderator on the site
It works perfectly. However, I need to adjust the width of multiple worksheets. it's possible?
This comment was minimized by the moderator on the site
There is a limit on the size - if the total height required is greater than 409.5, it will only do what would fit in 409.5 and spread it amongst the height of the merged cells and you would not see the remainder.  I was hoping this would solve for text lengths greater than the max row height (409.5).  I think you may need to iterate through and split the text to what can fit in to the first max height of 409.5 then put the rest in another cell (ZZ2) and so on until it fits, then count the rows in each cell then get the total required height.
This comment was minimized by the moderator on the site
Dang it, copy/paste bit me. Also, with explicit sheet references the With isn't needed:

Public Sub AutoFitMergedCells(oRange As Range, ByVal dblWidth As Double)



oRange.MergeCells = False

Sheet1.Range("A1") = oRange.Cells(1, 1).Value

Sheet1.Range("A1").WrapText = True

Sheet1.Columns(1).ColumnWidth = dblWidth

Sheet1.Rows(1).EntireRow.AutoFit

oRange.Parent.Rows(oRange.Row).Resize(oRange.Rows.Count).RowHeight _

= Sheet1.Rows(1).RowHeight / oRange.Rows.Count

oRange.MergeCells = True

oRange.WrapText = True



End Sub
This comment was minimized by the moderator on the site
Thank you, that helped me with a sheet I've not been happy with for years.

I did change things around a bit, my merged cells are all in one column so I calculated that outside the loop and passed it. I also inserted a Sheet1 that is hidden, and manipulated the columns/rows there so as to not affect the sheet I'm working on. The references should probably be more explicit:

Public Sub AutoFitMergedCells(oRange As Range, ByVal dblWidth As Double)



Dim dblHeight As Double



With oRange.Parent

oRange.MergeCells = False

Sheet1.Range("A1") = oRange.Cells(1, 1).Value

Sheet1.Range("A1").WrapText = True

Sheet1.Columns(1).ColumnWidth = dblWidth

Sheet1.Rows(1).EntireRow.AutoFit

dblHeight = Sheet1.Rows(1).RowHeight / oRange.Rows.Count

oRange.Parent.Rows(oRange.Row).Resize(oRange.Rows.Count).RowHeight = newHeight

oRange.MergeCells = True

oRange.WrapText = True

Sheet1.Range("A1").ClearContents

End With



End Sub
This comment was minimized by the moderator on the site
This not work for me}
This comment was minimized by the moderator on the site
not working , ye password set in your code not working in your code
This comment was minimized by the moderator on the site
I believe the reason that the row heights do not calculate properly is related to these lines of code
For iPtr = 1 To oRange.Columns.Count
oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
Next iPtr
oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth

The variable OldWidth gets set to the sum of the column widths in the range, but for some reason it gets reset to only the width of the first two columns. The first 3 lines of code are therefore made redundant by the 4th line. When I removed the line it was much better, but the other issue I found was that you have to make sure that the font and font size of the temporary cell (ZZ1 in the example code) must match the font and size of the merged cells; otherwise, text will not wrap in the same way as the merged cells wrap and may not be the correct height.
This comment was minimized by the moderator on the site
I made add-in for Auto fit row height of multiple merged cells.
Please use this, if you want to autofit row hight.
[Release Ver2.6 · toowaki/AutoFitRowEx · GitHub]
https://github.com/toowaki/AutoFitRowEx/releases/tag/2.6.2
This comment was minimized by the moderator on the site
This is pretty helpful, thanks!
This comment was minimized by the moderator on the site
I am trying to understand the necessity of Line 19. You are assigning a value again to OldWidth. Can you please explain?
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations