Note: The other languages of the website are Google-translated. Back to English

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

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

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

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

箭頭藍色右氣泡 使用VBA代碼自動調整合併單元格的行高


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

Doc-autafit-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-autafit-Cells-1


相關文章:

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


最佳辦公效率工具

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

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

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

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

<p >


最佳辦公效率工具

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

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

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

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

按評論排序
留言 (26)
還沒有評分。 成為第一位評論!
網站主持人對此評論進行了最小化
此代碼會導致刪除其他行。 我在左側有數字,旁邊的列是合併/包裝的數據。 例如,在職位描述中,用數字列出職責,然後解釋職責。 有什麼想法嗎? 謝謝。
網站主持人對此評論進行了最小化
我輸入了以下內容,但收到錯誤消息“運行時錯誤'13':類型不匹配”幫助? 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")) 調用 AutoFitMergedCells(Range("b22:h22")) 調用 AutoFitMergedCells(Range("b24:h24")) 調用 AutoFitMergedCells(Range("a26:h26")) 調用 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, n ewWidth) .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
網站主持人對此評論進行了最小化
非常感謝您的代碼! 它終於起作用了,但是......我的行高變得太高了。 有解決辦法嗎? 非常感謝! 這是我的代碼: 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")) 調用 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
網站主持人對此評論進行了最小化
嗨 Danielle,我在第一行第二次運行宏時遇到了同樣的問題。 該代碼使用 .Rows("1").EntireRow.AutoFit (第 26 行),如果您在 A1:B1 上運行,您的 A1 單元格從第 30 行開始將 WordWrapping 設置為 ON。最簡單的解決方案似乎是切換 WordWrapping在子的開頭關閉。 在第 13 行和第 14 行之間添加 oRange.WrapText = True ,你應該沒問題。
網站主持人對此評論進行了最小化
因為 ZZ1 的“幫助”單元格使用第一行(ZZ 列,第 1 行),如果第 1 行中的任何內容比您要調整的行中的文本高,那麼您得到的高度將高於您想要的高度. 為了解決這個問題,我將幫助單元格設為與 oRange 中的第一列相同的列,並將行號設置為 Excel 中的最後一行。 希望這對你有幫助,就像對我一樣。 8) 我的代碼: 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.行) & ":" & CStr(oRange.Row + oRange.Rows.Co unt - 1)).RowHeight = newHeight oRange.MergeCells = True oRange.WrapText = True .Cells("1048576", oRange.Column).ClearContents .Cells("1048576", oRange.Column).ColumnWidth = oldZZWidth End With End子
網站主持人對此評論進行了最小化
非常感謝您的代碼! 我對這個代碼有同樣的問題,比如 DANIËLLE_01。
網站主持人對此評論進行了最小化
感謝您的代碼,幾乎是我需要的。 不過有兩點說明:1)當我在與“幫助”單元格(ZZ1)相同的行中運行宏時,自動調整(第 26 行)會搞砸,因為整個字符串都適合一個窄單元格。 我建議在開頭添加 oRange.WrapText = False (或者如果可能的話,將輔助單元格移開)。 2) 第 19 行的目的是什麼? 您在第 16-18 行計算 oldWidth,但隨後僅使用兩列覆蓋第 19 行的計算。 當我在三列寬的合併單元格上嘗試 sub 時,當我忽略該行時效果更好......再次感謝
網站主持人對此評論進行了最小化
非常感謝您的代碼。 一旦您在字段中鍵入文本並按 Enter,有什麼方法可以使宏運行?
網站主持人對此評論進行了最小化
輝煌但與丹妮爾完全相同的問題,現在行太高了。 請有人幫忙!
網站主持人對此評論進行了最小化
工作完美,但行太高了! 我們能解決這個問題嗎?
網站主持人對此評論進行了最小化
感謝您發布此信息,我很擅長 excel,通常可以找出我的調整,但我似乎無法找到解決我遇到的問題的方法,或者是否存在問題。 我在單元格中有大量數據(超過了 409.5 的單個單元格高度限制)。 問題是這個 VBA 以同樣的限制運行。 因此,即使合併了行並且合併的單元格高度餘量為 819,我的一些數據也會被截斷,因為 VBA 根據單個 ZZ1 單元格調整單元格高度。 無論如何調整代碼以使其允許調整後的單元格高度包含合併行中的可用高度,還是我要求不可能? 謝謝。
網站主持人對此評論進行了最小化
謝謝你的代碼。 但是,我的行的高度確實會調整,但現在已經足夠了。 我該如何糾正這個問題?
網站主持人對此評論進行了最小化
因為 ZZ1 的“幫助”單元格使用第一行(ZZ 列,第 1 行),如果第 1 行中的任何內容比您要調整的行中的文本高,那麼您得到的高度將高於您想要的高度. 為了解決這個問題,我將幫助單元格設為與 oRange 中的第一列相同的列,並將行號設置為 Excel 中的最後一行。 希望這對你有幫助,就像對我一樣。 8) 我的代碼: 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.行) & ":" & CStr(oRange.Row + oRange.Rows.Co unt - 1)).RowHeight = newHeight oRange.MergeCells = True oRange.WrapText = True .Cells("1048576", oRange.Column).ClearContents .Cells("1048576", oRange.Column).ColumnWidth = oldZZWidth End With End子
網站主持人對此評論進行了最小化
我的代碼甚至無法運行當我嘗試調用 AutoFitMergedCells - 預期函數或變量時,我只是得到一個編譯錯誤?
網站主持人對此評論進行了最小化
我試圖理解第 19 行的必要性。您再次為 OldWidth 賦值。 你能解釋一下嗎?
網站主持人對此評論進行了最小化
我為多個合併單元格的自動調整行高製作了插件。
如果你想自動調整行高,請使用這個。
[發布Ver2.6·toowaki/AutoFitRowEx·GitHub]
https://github.com/toowaki/AutoFitRowEx/releases/tag/2.6.2
網站主持人對此評論進行了最小化
這很有幫助,謝謝!
網站主持人對此評論進行了最小化
我認為行高計算不正確的原因與這些代碼行有關
對於 iPtr = 1 到 oRange.Columns.Count
oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
下一個 iPtr
oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth

變量 OldWidth 被設置為範圍內列寬的總和,但由於某種原因,它被重置為僅前兩列的寬度。 因此,前 3 行代碼在第 4 行中變得多餘。 當我刪除該行時,它好多了,但我發現的另一個問題是您必須確保臨時單元格(示例代碼中的 ZZ1)的字體和字體大小必須與合併單元格的字體和大小匹配; 否則,文本將不會以與合併單元格相同的方式換行,並且可能不是正確的高度。
網站主持人對此評論進行了最小化
不起作用,您的代碼中設置的密碼在您的代碼中不起作用
網站主持人對此評論進行了最小化
這對我不起作用}
網站主持人對此評論進行了最小化
謝謝,這對我多年來一直不滿意的工作表有所幫助。

我確實改變了一些東西,我合併的單元格都在一列中,所以我在循環之外計算並傳遞了它。 我還插入了一個隱藏的 Sheet1,並在那裡操作了列/行,以免影響我正在處理的工作表。 引用可能應該更明確:

公共子 AutoFitMergedCells(oRange 作為範圍,ByVal dblWidth 作為雙精度)



將 dblHeight 調暗為 Double



使用 oRange.Parent

oRange.MergeCells = False

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

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

Sheep1.Columns(1).ColumnWidth = dblwidth

Sheet1.Rows(1).EntireRow.AutoFit

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

橙色。

oRange.MergeCells = True

橙色。wrapText= true

Sheet1.Range("A1").ClearContents

結束



END SUB
網站主持人對此評論進行了最小化
該死,複製/粘貼咬我。 此外,對於明確的工作表引用,不需要 With:

公共子 AutoFitMergedCells(oRange 作為範圍,ByVal dblWidth 作為雙精度)



oRange.MergeCells = False

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

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

Sheep1.Columns(1).ColumnWidth = dblwidth

Sheet1.Rows(1).EntireRow.AutoFit

橙色。

= Sheet1.Rows(1).Rowheight / Orange.Rows.Count

oRange.MergeCells = True

橙色。wrapText= true



END SUB
網站主持人對此評論進行了最小化
大小有限制 - 如果所需的總高度大於 409.5,它只會執行適合 409.5 的操作,並將其分佈在合併單元格的高度中,您將看不到其餘部分。 我希望這可以解決大於最大行高(409.5)的文本長度。 我認為您可能需要遍歷並將文本拆分為適合第一個最大高度 409.5 的文本,然後將其餘部分放在另一個單元格(ZZ2)中,依此類推,直到適合,然後計算每個單元格中的行數然後得到所需的總高度。
這裡還沒有評論
載入更多
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點