如何自動適應Excel中合併單元格的行高？

在Excel中，我們可以使用來快速調整行高以適合單元格內容 自動調整行高 功能，但此功能將完全忽略合併的單元格。也就是說，您無法應用 自動調整行高 功能以調整合併單元格的行高大小，您需要手動調整合併單元格的行高。在本文中，我將介紹一些解決此問題的快速方法。

使用VBA代碼自動調整合併單元格的行高

Office選項卡在Office中啟用選項卡式編輯和瀏覽，並使您的工作更加輕鬆...

閱讀更多... 免費下載...

Kutools for Excel解決了您的大多數問題，並使您的生產率提高了80％

重用任何東西：將最常用或最複雜的公式，圖表等添加到您的收藏夾中，並在將來快速重用它們。
超過20種文字功能：從文本字符串中提取數字；提取或刪除部分文字；將數字和貨幣轉換為英文單詞。
合併工具：將多個工作簿和工作表合二為一；合併多個單元格/行/列，而不會丟失數據；合併重複的行和總和。
分割工具：根據價值將數據分割成多個工作表；一本工作簿可轉換為多個Excel，PDF或CSV文件；一列到多列。
跳過粘貼隱藏/過濾的行；計數與求和按背景色; 向多個收件人批量發送個性化電子郵件。
超級過濾器：創建高級過濾方案並應用於任何工作表；分類按星期，日期，頻率等篩選用粗體，公式，註釋...
超過300種強大的功能；適用於Office 2007-2019和365; 支持所有語言；在您的企業或組織中輕鬆部署。

閱讀更多... 免費下載...

使用VBA代碼自動調整合併單元格的行高

驚人！在Excel中使用高效選項卡，例如Chrome，Firefox和Safari！

每天節省50％的時間，並減少數千次鼠標單擊！

假設我有一個包含一些合併單元格的工作表，如下面的屏幕快照所示，現在我需要調整單元格行高的大小以顯示整個內容，下面的VBA代碼可以幫助您自動調整多個合併單元格的行高，請執行如下：

doc-autofit-merged-cells-1

1。按住 ALT + F11 鍵，然後打開 Microsoft Visual Basic for Applications窗口.

2。點擊插入 > 模塊，然後將以下代碼粘貼到 模塊窗口.

VBA代碼：自動適合多個合併單元格的行高

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

筆記：

（1.）在上面的代碼中，您可以添加新範圍，只需複制 調用AutoFitMergedCells（Range（“ a1：b2”）） 根據需要多次編寫腳本，然後將合併的單元格範圍更改為所需的範圍。

（2.）並且您應該更改當前工作表名稱 Sheet4 到您使用的工作表名稱。

3。然後按 F5 鍵來運行此代碼，現在，您可以看到所有合併的單元格已自動適應其單元格內容，請參見屏幕截圖：

doc-autofit-merged-cells-1

相關文章：

如何在Excel中自動調整列寬？

最佳辦公效率工具

Kutools for Excel解決了您的大多數問題，並使您的生產率提高了80％

重用: 快速插入 複雜的公式，圖表 以及您以前使用過的任何東西；加密單元帶密碼創建郵件列表並發送電子郵件...
超級公式欄（輕鬆編輯多行文本和公式）；閱讀版式（輕鬆讀取和編輯大量單元格）；粘貼到過濾範圍...
合併單元格/行/列不會丟失數據；拆分單元格內容；合併重複的行/列...防止細胞重複；比較範圍...
選擇重複或唯一行; 選擇空白行（所有單元格都是空的）；超級查找和模糊查找在許多工作簿中；隨機選擇...
確切的副本多個單元格，無需更改公式參考；自動創建參考到多張紙；插入項目符號，複選框等...
提取文字，添加文本，按位置刪除，刪除空間; 創建和打印分頁小計；在單元格內容和註釋之間轉換...
超級濾鏡（將過濾方案保存並應用於其他工作表）；高級排序按月/週/日，頻率及更多；特殊過濾器用粗體，斜體...
結合工作簿和工作表; 根據關鍵列合併表；將數據分割成多個工作表; 批量轉換xls，xlsx和PDF...
超過300種強大功能。支持Office / Excel 2007-2019和365。支持所有語言。在您的企業或組織中輕鬆部署。完整功能30天免費試用。 60天退款保證。

閱讀更多... 免費下載... 採購...

Office選項卡為Office帶來了選項卡式界面，使您的工作更加輕鬆

在Word，Excel，PowerPoint中啟用選項卡式編輯和閱讀，發布者，Access，Visio和Project。
在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
每天將您的工作效率提高50％，並減少數百次鼠標單擊！

閱讀更多... 免費下載... 採購...

<p >

最佳辦公效率工具

Kutools for Excel解決了您的大多數問題，並使您的生產率提高了80％

重用: 快速插入 複雜的公式，圖表 以及您以前使用過的任何東西；加密單元帶密碼創建郵件列表並發送電子郵件...

超級公式欄（輕鬆編輯多行文本和公式）；閱讀版式（輕鬆讀取和編輯大量單元格）；粘貼到過濾範圍...

合併單元格/行/列不會丟失數據；拆分單元格內容；合併重複的行/列...防止細胞重複；比較範圍...

選擇重複或唯一行; 選擇空白行（所有單元格都是空的）；超級查找和模糊查找在許多工作簿中；隨機選擇...

確切的副本多個單元格，無需更改公式參考；自動創建參考到多張紙；插入項目符號，複選框等...

提取文字，添加文本，按位置刪除，刪除空間; 創建和打印分頁小計；在單元格內容和註釋之間轉換...

超級濾鏡（將過濾方案保存並應用於其他工作表）；高級排序按月/週/日，頻率及更多；特殊過濾器用粗體，斜體...

結合工作簿和工作表; 根據關鍵列合併表；將數據分割成多個工作表; 批量轉換xls，xlsx和PDF...

超過300種強大功能。支持Office / Excel 2007-2019和365。支持所有語言。在您的企業或組織中輕鬆部署。完整功能30天免費試用。 60天退款保證。

閱讀更多... 免費下載... 採購...

Office選項卡為Office帶來了選項卡式界面，使您的工作更加輕鬆

在Word，Excel，PowerPoint中啟用選項卡式編輯和閱讀，發布者，Access，Visio和Project。

在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。

每天將您的工作效率提高50％，並減少數百次鼠標單擊！

閱讀更多... 免費下載... 採購...

</ p >

22 Comments
Login

Sort by Newest
- Best
- Popular
- Newest
- Oldest

You are guest

or post as a guest, but your post won't be published automatically.

Loading comment... The comment will be refreshed after 00:00.

To post as a guest, your comment is unpublished.
Art · 1 years ago
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
- Reply
To post as a guest, your comment is unpublished.
Art · 1 years ago
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
- Reply
To post as a guest, your comment is unpublished.
José · 2 years ago
This not work for me}
- Reply
To post as a guest, your comment is unpublished.
saravanan · 2 years ago
not working , ye password set in your code not working in your code
- Reply
To post as a guest, your comment is unpublished.
dougs · 2 years ago
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.
- Reply
To post as a guest, your comment is unpublished.
toowaki · 3 years ago
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
- Reply
- To post as a guest, your comment is unpublished.
  ABC · 3 years ago
  
  This is pretty helpful, thanks!
  
  Reply
To post as a guest, your comment is unpublished.
Krishna · 3 years ago
I am trying to understand the necessity of Line 19. You are assigning a value again to OldWidth. Can you please explain?
- Reply
To post as a guest, your comment is unpublished.
Chris · 4 years ago
My code will not even run I just get a compile error when I try to call the AutoFitMergedCells - Expected Function or variable?
- Reply
To post as a guest, your comment is unpublished.
Aperture · 4 years ago
Because the "helper" cell of ZZ1 is using the first row (column ZZ, row 1), if there is ANYTHING in row 1 taller than the text in the row you want to adjust, your resulting height will be taller than what you want.

To fix this, I made the helper cell the same column as the first column in the oRange and set the row number to the very last row in Excel. Hope this helps you like it does me. 8)

[u]My Code:[/u]

Option Explicit
Public Sub AutoFitAll()
Call AutoFitMergedCells(Range("A2:Z2"))

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("Sheet1")
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 = .Cells("1048576", oRange.Column).ColumnWidth
.Cells("1048576", oRange.Column) = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
.Cells("1048576", oRange.Column).WrapText = True
.Columns(oRange.Column).ColumnWidth = oldWidth
.Rows("1048576").EntireRow.AutoFit
newHeight = .Rows("1048576").RowHeight / oRange.Rows.Count
.Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
oRange.MergeCells = True
oRange.WrapText = True
.Cells("1048576", oRange.Column).ClearContents
.Cells("1048576", oRange.Column).ColumnWidth = oldZZWidth
End With
End Sub
- Reply
To post as a guest, your comment is unpublished.
Retha · 4 years ago
Thank you for the code. However, the height of my rows do adjust, but now enough. How can I rectify this?
- Reply
To post as a guest, your comment is unpublished.
Jeff · 4 years ago
Thanks for posting this, I'm decent with excel and can usually figure out my adjustments but I can't seem to figure out a fix for an issue I'm having, or if one even exists. I have huge amounts of data in the cells (exceeding the single cell height limit of 409.5). The problem is this VBA runs with that same limitation. So some of my data gets cut off even though the rows are merged and the combined cell height allowance is 819, since the VBA adjusts the cell height based off the single ZZ1 cell. Is there anyway to adjust the code to get it to allow the adjusted cell height to include the available height in the merged rows or am I asking for the impossible? Thanks.
- Reply
To post as a guest, your comment is unpublished.
Vivi · 4 years ago
Works perfect, but rows are too high! Can we fix this?
- Reply
To post as a guest, your comment is unpublished.
Hana · 4 years ago
Brilliant but exactly the same problem as Danielle, rows are too high now. Please someone help!
- Reply
To post as a guest, your comment is unpublished.
Susan · 4 years ago
Thanks so much for the code. Is there any way to make the macro run as soon as you type text in a field and hit enter?
- Reply
To post as a guest, your comment is unpublished.
Viktor · 4 years ago
Thanks for the code, pretty much what I needed.

Two remarks, though:
1) when I run the macro in the same row as the "helper"cell (ZZ1), autofit (line 26) will mess up, because the whole string is fitted into one narow cell. I recommend adding

oRange.WrapText = False

in the beginning (or moving the helper cell somewhere out of the way, if possible).
2) what's the purpose of line 19? You claculate oldWidth in lines 16-18, but then override the calculation in line 19, using only two columns. When I tried the sub on a three-column-wide merged cells, it worked better when I ignored the line...

Thanks again
- Reply
To post as a guest, your comment is unpublished.
Afshin · 5 years ago
Thanks a lot for the code! I have same problem with this code such as DANIËLLE_01.
- Reply
To post as a guest, your comment is unpublished.
Daniëlle_01 · 5 years ago
Thanks a lot for the code! It finally works, but... My row height becomes too height. Is there a solution for?

Thanks a lot!

[u]This is my code:[/u]

Option Explicit
Public Sub AutoFitAll()
Call AutoFitMergedCells(Range("b162:i162"))
Call AutoFitMergedCells(Range("b166:i166"))
Call AutoFitMergedCells(Range("b168:i168"))
Call AutoFitMergedCells(Range("b170:i170"))
Call AutoFitMergedCells(Range("b172:i172"))
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("Rapport")
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
- Reply
- To post as a guest, your comment is unpublished.
  Aperture · 4 years ago
  
  Because the "helper" cell of ZZ1 is using the first row (column ZZ, row 1), if there is ANYTHING in row 1 taller than the text in the row you want to adjust, your resulting height will be taller than what you want.
  
  To fix this, I made the helper cell the same column as the first column in the oRange and set the row number to the very last row in Excel. Hope this helps you like it does me. 8)
  
  [u]My Code:[/u]
  
  Option Explicit
  Public Sub AutoFitAll()
  Call AutoFitMergedCells(Range("A2:Z2"))
  
  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("Sheet1")
  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 = .Cells("1048576", oRange.Column).ColumnWidth
  .Cells("1048576", oRange.Column) = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
  .Cells("1048576", oRange.Column).WrapText = True
  .Columns(oRange.Column).ColumnWidth = oldWidth
  .Rows("1048576").EntireRow.AutoFit
  newHeight = .Rows("1048576").RowHeight / oRange.Rows.Count
  .Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
  oRange.MergeCells = True
  oRange.WrapText = True
  .Cells("1048576", oRange.Column).ClearContents
  .Cells("1048576", oRange.Column).ColumnWidth = oldZZWidth
  End With
  End Sub
  
  Reply
- To post as a guest, your comment is unpublished.
  Viktor · 4 years ago
  
  Hi Danielle,
  
  I ran into the same problem, when running the macro a second time in the first row. The code uses
  
  .Rows("1").EntireRow.AutoFit (line 26)
  
  and if you run in on, say A1:B1, your A1 cell has WordWrapping set to ON from line 30.
  
  The easiest solution seems to be switching WordWrapping off at the beginning of the sub. Add
  
  oRange.WrapText = True
  
  between lines 13 and 14 and you should be OK.
  
  Reply
To post as a guest, your comment is unpublished.
Dina · 5 years ago
I have the following entered, but I get an error message "Run-time error '13': Type mismatch" Help?

Option Explicit
Public Sub AutoFitAll()
Call AutoFitMergedCells(Range("a8:h8"))
Call AutoFitMergedCells(Range("a10:h10"))
Call AutoFitMergedCells(Range("a11:h11"))
Call AutoFitMergedCells(Range("b17:h17"))
Call AutoFitMergedCells(Range("b22:h22"))
Call AutoFitMergedCells(Range("b24:h24"))
Call AutoFitMergedCells(Range("a26:h26"))
Call AutoFitMergedCells(Range("a28:h28"))

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("Offer Letter")
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
- Reply
To post as a guest, your comment is unpublished.
Joe Dell · 5 years ago
This code causes additional rows to be deleted. I have numbers on left side and columns next to it are merged/wrapped data. For example, in a Job description, list responsibilities with numbers followed by explanation of duty. Any thoughts? Thanks.
- Reply

登錄到您的帳戶

重設密碼