Question

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

以下代码将调整工作表上的所有列（根据需要），但是使用标准“自动调整”函数对列中的所有行（不仅仅是标题行）进行调整。

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

我不知道如何为每列AutoFit宽度添加宽度。我已经确定我想为每个宽度添加3.0以便能够读取标题，而不会使用下拉过滤器箭头切断文本。

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

有关如何实现此目的或如何改进上述代码以避免使用选择的任何建议？

Answer 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

Answer 2

我在搜索中找到了与您发布的同一问题的答案相关的线索。

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

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

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

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

2 个答案: