フィルタードロップダウンのためのスペースを許可するヘッダーの列幅を自動調整

Question

ヘッダー列のテキストとフィルタがオンのときに表示されるドロップダウン矢印に合わせて、ワークシートの各列の幅のサイズを変更しようとしています。

次のコードは、ワークシート上のすべての列のサイズを変更します（ただし、ヘッダー行だけでなく）列のすべての行に対して標準の自動フィット機能を使用します。

以下のコードは、ヘッダー行のみに基づいて列のサイズを設定するので、私が達成しようとしているものに近いです。

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を追加したいと決めました。

私の考えは、各ヘッダーに2つのスペースを追加し、各ヘッダーの列を自動調整することです。

これを達成する方法や、上記のコードを改善して選択を使用しない方法に関する提案はありますか？

Answer 1

私が質問を作成する過程で、私は解決策を考え出すことができました。

以下のコードは、ユーザーがヘッダーを含む行を定義できるようにします。マクロは、任意の値を含むユーザー定義の 'ヘッダー行'の各セルに2つのスペースを追加します。これらの調整された「ヘッダーセル」の幅は、オートフィットされます。

これはうまくいくようですが、他の誰かがコードを改善したり、マクロをより有用にするための機能強化を提供できるのであれば不思議です。

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