允许过滤器下拉箭头空间的标题的自动调整列宽答案

【问题标题】：Auto Fit Column Width for Headers that Allows Space for Filter Drop Down Arrow允许过滤器下拉箭头空间的标题的自动调整列宽
【发布时间】：2020-08-26 00:47:53
【问题描述】：

我正在尝试调整工作表上每一列的宽度，以适应标题列中的文本以及打开过滤器时出现的下拉箭头。

以下代码将调整工作表上所有列的大小（根据需要），但会在列中的所有行（不仅仅是标题行）上使用标准的“自动调整”功能。

Worksheets("Sheet2").Cells.EntireColumn.AutoFit

下面的代码更接近我想要完成的内容，因为它仅根据标题行调整列的大小。

Dim HeaderRow As Range

Set HeaderRow = Application.InputBox("Select the row which contains the headers", "Obtain     Range Object", Type:=1)

HeaderRow.Select

Selection.Columns.AutoFit

我被困在如何为每列自动调整宽度添加宽度。我已经确定我想为每个宽度添加 3.0，以便能够在没有下拉过滤箭头切断文本的情况下读取标题。

我的想法是为每个标题添加两个空格，然后自动调整每个标题列。

关于如何实现这一点或如何改进上面的代码以不使用选择的任何建议？

【问题讨论】：

标签： excel vba

【解决方案1】：

在我起草问题的过程中，我想出了一个解决方案。

下面的代码允许用户定义哪一行包含他们的标题。然后，宏将两个空格添加到用户定义的“标题行”中的每个单元格，其中包含任何值。这些调整后的“标题单元格”的宽度会自动适应。

这似乎运作良好，但我很好奇是否有其他人可以提供代码改进或增强功能以使宏更有用？

Sub Resize_Header_Column()

'==========================================================================
'This macro will resize the column width to fit the text in the header row of a spreadsheet as well as 
'allow space for the drop down filter arrows to not cut off the text of a header
'=========================================================================


ColumnLetter = Split(Cells.Find(What:="*", After:=[A1],     SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Cells.Address(1, 0), "$")(0)

Dim HeaderRow As Long
HeaderRow = Application.InputBox("Insert the row number which contains the headers", "Obtain     Range Object", Type:=1)

Dim HeaderRange As String
HeaderRange = "A" & HeaderRow & ":" & ColumnLetter & HeaderRow

Range(HeaderRange).Select

For Each r In Selection
With r
    .Value = .Text & "  "
End With
Next r

Selection.Columns.AutoFit

End Sub

【讨论】：

【解决方案2】：

我在搜索您发布的同一问题的答案时发现了此主题。

如果您的列标题是列中最大的元素（因此是自动调整的限制因素），请使用

Worksheets("Sheet2").Range("A1:H1").AutoFit

请注意，这假定您的列标题位于从 A 列到 H 列的单行（第 1 行）中。这将强制自动调整功能仅使用列标题单元格来确定适当的宽度。只需确保在应用 AutoFilter 后应用 AutoFit。

【讨论】：