在兩者上自動調整行高：使用合併單元格的列和使用單元格的列

Question

我使用VBA生成巨大的Excel模板。有一個標準的合併單元格列，其中包含各種不同長度的描述。單獨這個標準描述列是好的，因爲所有行當前都設置了正確的長度。

第二列由用於用戶註釋的單個單元組成，其總是具有不同的文本長度。當然，當用戶輸入被設置爲預定單元格的值時：文本行很可能被切斷。這是一個常見問題，很明顯，解決方案是設置一個宏來運行行高自動調整。

這是問題開始的地方。

在用戶註釋的第二列上運行行高自動調整時，第一列描述中的許多合併單元格被設置爲行高度太小而不能顯示其所有文本。

有關如何在不降低第一列的行高的情況下自動調整第二列用戶註釋的行高的任何想法？

有沒有辦法設置最小行高並仍然運行autofit？

Answer 1

這對我有用。它通過調整最後一個單元格的行高來調整第一列的合併單元格的大小，否則文本將被截斷。

稍微複雜一點的版本可能會劃分合併區域中所有行之間的高度差，而不是將其添加到單個行中。我可以離開，作爲一個練習...

Sub FixHeights() 

Dim rng As Range, col As Range, m As Range, c As Range 
Dim i As Long, n As Long, fh 
Dim fHeights() 

    Set rng = Range("B4:C11") 'for example... 

    'to store merged areas and their fitted heights 
    ReDim fHeights(1 To rng.Rows.Count, 1 To 2) 

    'run though the first column and find merged 
    ' areas and "fitted heights" 
    Set col = rng.Columns(1) 
    n = 0 
    For Each c In col.Cells 
     Set m = c.MergeArea 
     If m.Cells.Count > 1 And c.Row = m.Cells(1).Row Then 
      n = n + 1 
      Set fHeights(n, 1) = m 
      fHeights(n, 2) = GetFittedHeight(m) 
     End If 
    Next c 

    'autofit the second column row heights 
    rng.Columns(2).Rows.AutoFit 

    'recheck the first column: if any merged area is 
    ' too short, then increase the last row's height 
    For i = 1 To n 
     Set m = fHeights(i, 1) 
     fh = fHeights(i, 2) 
     Debug.Print m.Height, fh 
     If m.Height < fh Then 
      With m.Cells(m.Cells.Count) 
       .RowHeight = .RowHeight + (fh - m.Height) 
      End With 
     End If 
    Next i 

End Sub 

'get the "fitted height" of a merged area 
Function GetFittedHeight(ma As Range) 
Dim ht 
    With ma 
     .UnMerge 
     .Cells(1).EntireRow.AutoFit 
     ht = .Cells(1).RowHeight 
     .Merge 
     .EntireRow.AutoFit 
    End With 
    GetFittedHeight = ht 
End Function