常在Excel走,哪有不調行高?
如果是碰到這種情況:
處女座的你是否會關掉、刪了它?
????其他星座呢?嘴上笑嘻嘻,心里MMP地也要忍痛把格式調好...
接下來就教大家怎么簡單又快速地調整行高吧。
1、自動調整行高
Excel的單元格有“自動調整行高”和“自動調整列寬”的模式,方法就是把鼠標放在需要調整的單元列(行)邊上,當鼠標變成【十】時,雙擊,就可以了。
2、批量調整
上面的方法只適用于不含【合并單元格】的表格,如果表格中包含了【合并單元格】,則無法通過【自動調整】來實現
如上圖那樣,根本【自動】不了。。。
所以還是只能用【宏】了,代碼如下:
?Sub?My_MergeCell_AutoHeight()
?Dim?rh?As?Single,?mw?As?Single
?Dim?rng?As?Range,?rrng?As?Range,?n1%,?n2%
?Dim?aw?As?Single,?rh1?As?Single
?Dim?m$,?n$,?k
?Dim?ir1,?ir2,?ic1,?ic2
?Dim?mySheet?As?Worksheet
?Dim?selectedA?As?Range
?Dim?wrkSheet?As?Worksheet
Application.ScreenUpdating?=?False
?Set?mySheet?=?ActiveSheet
?On?Error?Resume?Next
Err.Number?=?0
?Set?selectedA?=?Application.Intersect(ActiveWindow.RangeSelection,?mySheet.UsedRange)?'返回重疊range
??????? selectedA.Activate
?If?Err.Number?<>?0?Then
g?=?MsgBox("請先選擇需要'最合適行高'的行!",?vbInformation)
?Return
?End?If
??????? selectedA.EntireRow.AutoFit
?Set?wrkSheet?=?ActiveWorkbook.Worksheets.Add?'創建個臨時sheet來折騰
?For?Each?rrng?In?selectedA
?If?rrng.Address?<>?rrng.MergeArea.Address?Then?'找出合并單元格
?If?rrng.Address?=?rrng.MergeArea.Item(1).Address?Then?'合并單元格第一格與地址對應
??????????????? ????'If (Application.Intersect(selectedA, rrng).Address <> rrng.Address) Then
?'??? GoTo gotoNext
?'End If
?Dim?tempCell?As?Range
?Dim?width?As?Double
?Dim?tempcol
width?=?0
?For?Each?tempcol?In?rrng.MergeArea.Columns
width?=?width?+?tempcol.ColumnWidth
?Next
??????????????????? wrkSheet.Columns(1).WrapText?=?True
????????????? ??????wrkSheet.Columns(1).ColumnWidth?=?width
??????????????????? wrkSheet.Columns(1).Font.Size?=?rrng.Font.Size
??????????????????? wrkSheet.Cells(1,?1).Value?=?rrng.Value
??????????????????? wrkSheet.Activate
?'wrkSheet.Cells(1, 1).RowHeight = 0
??????????????????? wrkSheet.Cells(1,?1).EntireRow.Activate
??????????????????? wrkSheet.Cells(1,?1).EntireRow.AutoFit
??????????????????? mySheet.Activate
??????????????????? rrng.Activate
?If?(rrng.RowHeight?<?wrkSheet.Cells(1,?1).RowHeight)?Then
?Dim?tempHeight?As?Double
?Dim?tempCount?As?Integer
?Dim?addHeightRow
tempHeight?=?wrkSheet.Cells(1,?1).RowHeight?+?10?'自動調整后行高+10
tempCount?=?rrng.MergeArea.Rows.Count?'多行合并單元格的行數
?For?Each?addHeightRow?In?rrng.MergeArea.Rows?'選區中每個row賦值
?If?(addHeightRow.RowHeight?<?tempHeight?/?tempCount)?Then
addHeightRow.RowHeight?=?tempHeight?/?tempCount
?End?If
tempHeight?=?tempHeight?-?addHeightRow.RowHeight
tempCount?=?tempCount?-?1
???????? ???????????????Next
?End?If
?End?If
?Else
?If?rrng.WrapText?=?True?Then?'非合并單元格、自動換行
rrng.RowHeight?=?rrng.RowHeight?+?3?'非合并行+3,以適應打印
?End?If
?End?If
?Next
Application.DisplayAlerts?=?False?'刪除工作表警告提示
??????? wrkSheet.Delete
Application.DisplayAlerts?=?True
Application.ScreenUpdating?=?True
?End?Sub
效果如下:
3、添加到按鈕功能
①新建一個空白文檔:
②復制上面的宏,粘貼:
③保存成【Excel97-2003加載宏(*.xla)】
這時它的路徑會自動變成【C:\Users\Administrator\AppData\Roaming\Microsoft\AddIns】
然后改個容易辨識的名字:
保存。
④在【加載項】里找到它
Excel2007~2016:【開始】-【Excel選項】-【加載項】-【轉到】
Excel2013~2016:還可以【開發工具】-【Excel加載項】
⑤添加自定義按鈕
以后打開其他表格都會有這個按鈕了
文件已經上傳網盤,下載后直接放在:
C:\Users\Administrator\AppData\Roaming\Microsoft\AddIns
然后在Excel選擇【加載項】即可找到它
關注公眾號,在后臺回復Excel行高即可獲取上述的.xla文檔
微信搜索公眾號@圣創雜學堂,即可獲取每天更新
原創不易,轉載請保留出處。