VBA思考する

Option Explicit ' 変数の宣言を強制

' 定数定義
Private Const MAX_COLUMN_WIDTH As Double = 255    ' Excelの列幅の最大値 (標準フォントの文字数)
Private Const MAX_ROW_HEIGHT As Double = 409.5  ' Excelの行の高さの最大値 (ポイント)
Private Const MIN_DIMENSION As Double = 0       ' 列幅や行高さの最小値 (0 = 非表示)

Sub ResizeSelectedRangeCells_Final_Practical_Revised()

    '--- 変数宣言 ---
    Dim selectedRange As Range          ' ユーザーが選択したセル範囲
    Dim col As Range                    ' ループ処理で個々の列を参照
    Dim rw As Range                     ' ループ処理で個々の行を参照
    Dim factorsInput As String          ' InputBoxからユーザーが入力した倍率 (文字列)
    Dim factorsArray As Variant         ' 入力された倍率文字列を分割した配列
    Dim xFactor As Double               ' 列倍率 (数値)
    Dim yFactor As Double               ' 行倍率 (数値)
    Dim currentWidth As Double          ' 変更前の列幅
    Dim currentHeight As Double         ' 変更前の行高
    Dim newWidth As Double              ' 計算後の新しい列幅
    Dim newHeight As Double             ' 計算後の新しい行高
    Dim i As Long                       ' ループカウンター (進捗表示用)
    Dim totalCount As Long              ' 列/行の総数 (進捗表示用)
    Dim confirmMsg As String            ' ユーザーへの確認メッセージ

    '--- Excelアプリケーション設定の保存用変数 ---
    Dim originalScreenUpdating As Boolean   ' 元の画面更新設定
    Dim originalEnableEvents As Boolean     ' 元のイベント処理設定
    Dim originalCalculation As XlCalculation ' 元の計算方法設定
    Dim originalStatusBar As Variant        ' 元のステータスバー表示内容
    Dim originalEnableCancelKey As XlEnableCancelKey ' 元のESCキーによる中断設定
    Dim originalCursor As Long              ' 元のマウスカーソル形状

    ' --- 初期設定とエラーハンドリング準備 ---
    On Error GoTo ErrorHandler ' エラー発生時はErrorHandlerへジャンプ
    originalEnableCancelKey = Application.EnableCancelKey ' 元のESCキー設定を保存
    Application.EnableCancelKey = xlErrorHandler          ' ESCキーでエラーハンドラに飛ぶように設定 (エラー番号18)

    ' 0. 範囲が選択されているか確認
    If TypeName(Selection) <> "Range" Then
        MsgBox "まず、セル範囲を選択してください。", vbExclamation, "範囲未選択"
        GoTo ExitProcedure ' 後始末処理へ
    End If
    Set selectedRange = Selection

    ' --- ユーザーからの倍率入力 (列と行をまとめて) ---
    factorsInput = InputBox("列の幅の倍率と行の高さの倍率をカンマ区切りで入力してください。" & vbCrLf & _
                            "(例: 1.5,2.0  または  列のみ変更: 1.5,1  行のみ変更: 1,2.0)" & vbCrLf & _
                            "現在の値を維持する場合は 1 を入力してください。", _
                            "倍率入力 (列,行)", "1.5,1.5")

    If factorsInput = vbNullString Then GoTo CancelledByUser ' キャンセルボタンが押された場合

    ' 入力値をカンマで分割
    factorsArray = Split(factorsInput, ",")

    ' 入力値の検証 (2つの値が入力されているか)
    If UBound(factorsArray) <> 1 Then
        MsgBox "列倍率と行倍率をカンマ区切りで2つ入力してください。" & vbCrLf & _
               "例: 1.5,2.0", vbCritical, "入力エラー"
        GoTo ExitProcedure
    End If

    ' 列倍率の検証と変換
    If Not IsNumeric(Trim(factorsArray(0))) Then
        MsgBox "列倍率には数値を入力してください。", vbCritical, "入力エラー"
        GoTo ExitProcedure
    End If
    xFactor = CDbl(Trim(factorsArray(0)))
    If xFactor <= 0 Then
        MsgBox "列倍率には正の数値を入力してください。", vbCritical, "入力エラー"
        GoTo ExitProcedure
    End If

    ' 行倍率の検証と変換
    If Not IsNumeric(Trim(factorsArray(1))) Then
        MsgBox "行倍率には数値を入力してください。", vbCritical, "入力エラー"
        GoTo ExitProcedure
    End If
    yFactor = CDbl(Trim(factorsArray(1)))
    If yFactor <= 0 Then
        MsgBox "行倍率には正の数値を入力してください。", vbCritical, "入力エラー"
        GoTo ExitProcedure
    End If

    ' --- 処理実行前の最終確認メッセージ作成 ---
    confirmMsg = "以下の設定で選択範囲 " & selectedRange.Address(False, False) & " のセルの大きさを変更します。" & vbCrLf & vbCrLf & _
                 "列倍率: " & xFactor & "倍" & vbCrLf & _
                 "行倍率: " & yFactor & "倍" & vbCrLf & vbCrLf & _
                 "この操作は元に戻すのが難しい場合があります。" & vbCrLf & _
                 "実行しますか？ (処理中にESCキーで中断可能)"

    If MsgBox(confirmMsg, vbQuestion + vbYesNo + vbDefaultButton2, "実行確認") = vbNo Then
        GoTo CancelledByUser ' 「いいえ」が選択された場合
    End If

    ' --- パフォーマンス向上のためのExcel設定変更 ---
    originalScreenUpdating = Application.ScreenUpdating
    originalEnableEvents = Application.EnableEvents
    originalCalculation = Application.Calculation
    originalStatusBar = Application.StatusBar
    originalCursor = Application.Cursor

    Application.ScreenUpdating = False      ' 画面更新を停止
    Application.EnableEvents = False        ' イベント処理を停止
    If originalCalculation <> xlCalculationManual Then
        Application.Calculation = xlCalculationManual ' 計算方法を手動に
    End If
    Application.Cursor = xlWait             ' マウスカーソルを待機状態に

    ' --- 列の幅の変更処理 ---
    If xFactor <> 1 Then ' 倍率が1でない場合のみ処理
        totalCount = selectedRange.Columns.Count
        Application.StatusBar = "列幅を変更中... (0%)"
        For i = 1 To totalCount
            Set col = selectedRange.Columns(i) ' 選択範囲内のi番目のユニークな列
            DoEvents ' ESCキーでの中断を可能にし、Excelの応答性を維持
            currentWidth = col.ColumnWidth
            newWidth = currentWidth * xFactor

            ' Excelの列幅制限値チェック
            If newWidth > MAX_COLUMN_WIDTH Then
                newWidth = MAX_COLUMN_WIDTH
            ElseIf newWidth < MIN_DIMENSION Then
                newWidth = MIN_DIMENSION
            End If

            col.ColumnWidth = newWidth ' 新しい列幅を設定
            If totalCount > 0 Then ' 0除算を避ける
                Application.StatusBar = "列幅を変更中... (" & Format(i / totalCount, "0%") & ")"
            End If
        Next i
    End If

    ' --- 行の高さの変更処理 ---
    If yFactor <> 1 Then ' 倍率が1でない場合のみ処理
        totalCount = selectedRange.Rows.Count
        Application.StatusBar = "行高を変更中... (0%)"
        For i = 1 To totalCount
            Set rw = selectedRange.Rows(i) ' 選択範囲内のi番目のユニークな行
            DoEvents ' ESCキーでの中断を可能にし、Excelの応答性を維持
            currentHeight = rw.RowHeight
            newHeight = currentHeight * yFactor

            ' Excelの行高さ制限値チェック
            If newHeight > MAX_ROW_HEIGHT Then
                newHeight = MAX_ROW_HEIGHT
            ElseIf newHeight < MIN_DIMENSION Then
                newHeight = MIN_DIMENSION
            End If

            rw.RowHeight = newHeight ' 新しい行の高さを設定
            If totalCount > 0 Then ' 0除算を避ける
                Application.StatusBar = "行高を変更中... (" & Format(i / totalCount, "0%") & ")"
            End If
        Next i
    End If

    ' --- 処理完了 ---
    Application.StatusBar = "処理が完了しました。" ' ステータスバーに完了メッセージを一時表示
    MsgBox "選択範囲 " & selectedRange.Address(False, False) & " のセルの大きさを変更しました。" & vbCrLf & vbCrLf & _
           "適用された列倍率: " & xFactor & "倍" & vbCrLf & _
           "適用された行倍率: " & yFactor & "倍", vbInformation, "処理完了"
    GoTo ExitProcedure ' 後始末処理へ

CancelledByUser:
    ' --- ユーザーによるキャンセル処理 ---
    MsgBox "処理はユーザーによってキャンセルされました。", vbInformation, "キャンセル"
    GoTo ExitProcedure ' 後始末処理へ

ErrorHandler:
    ' --- エラー発生時の処理 ---
    Dim errorMsgText As String
    errorMsgText = "エラーが発生しました。" & vbCrLf & vbCrLf & _
                   "エラー番号: " & Err.Number & vbCrLf & _
                   "エラー内容: " & Err.Description & vbCrLf & vbCrLf

    If Err.Number = 18 Then ' ユーザーによる中断 (ESCキー)
        MsgBox "処理はユーザーによって中断されました。", vbInformation, "中断"
    Else
        If Err.Number = 1004 Then ' 一般的な実行時エラー
            errorMsgText = errorMsgText & "原因の可能性: シートが保護されている、" & _
                                        "非表示の行/列の操作制限、" & _
                                        "または他のアプリケーションによるExcelの制御など。" & vbCrLf
        End If
        errorMsgText = errorMsgText & "処理は中断されました。"
        MsgBox errorMsgText, vbCritical, "エラー発生"
    End If
    GoTo ExitProcedure ' 後始末処理へ

ExitProcedure:
    ' --- 後始末処理 (必ず実行される) ---
    ' アプリケーション設定を元に戻す
    If Application.ScreenUpdating <> originalScreenUpdating Then Application.ScreenUpdating = originalScreenUpdating
    If Application.EnableEvents <> originalEnableEvents Then Application.EnableEvents = originalEnableEvents
    If Application.Calculation <> originalCalculation Then Application.Calculation = originalCalculation
    If Application.Cursor <> originalCursor Then Application.Cursor = originalCursor
    If Application.EnableCancelKey <> originalEnableCancelKey Then Application.EnableCancelKey = originalEnableCancelKey

    ' ステータスバーを元の状態に戻す
    If TypeName(originalStatusBar) = "Boolean" And originalStatusBar = False Then
        Application.StatusBar = False ' デフォルトに戻す
    ElseIf TypeName(originalStatusBar) = "String" Then
        Application.StatusBar = originalStatusBar ' 元の文字列に戻す
    Else
        Application.StatusBar = False ' 不明な場合はデフォルトに戻す
    End If

    ' オブジェクト変数を解放
    Set selectedRange = Nothing
    Set col = Nothing
    Set rw = Nothing

End Sub

---

Excelでピクセル単位の Width から文字数単位の ColumnWidth を逆算するには、VBAを使用するのが一般的です。この2つの値の関係は、標準フォントの種類やサイズ、OSのDPI設定などに影響されるため、単純な計算式で求めることは難しいです。

以下に、指定されたピクセル幅に最も近くなる ColumnWidth を探し出すVBA関数を示します。この関数は、一時的に列幅を変更しながら実際のピクセル幅を測定し、最適な ColumnWidth を見つけ出します。

VBAコード

このコードをVBE (Visual Basic Editor) の標準モジュールにコピーして使用してください。

Option Explicit

' 指定されたピクセル幅(targetPixelWidth)に最も近いColumnWidthを計算する関数
' targetPixelWidth: 目的のピクセル幅 (Double型)
' refColumn: (オプション) 幅計算の基準とする列。指定しない場合、新しい一時シートのA列を使用。
' 戻り値: 計算されたColumnWidth (Double型、小数点以下2桁)
Function GetColumnWidthFromPixels(targetPixelWidth As Double, Optional refColumn As Range = Nothing) As Double
    Dim tempSheet As Worksheet
    Dim tempCol As Range
    Dim originalColumnWidth As Double
    Dim cleanupTempSheet As Boolean
    Dim ws As Worksheet

    If refColumn Is Nothing Then
        ' 一時的なシートと列を作成
        Set ws = ThisWorkbook.Worksheets.Add
        Set tempCol = ws.Columns(1)
        cleanupTempSheet = True
    Else
        ' 指定された列を使用
        Set ws = refColumn.Worksheet
        Set tempCol = ws.Columns(refColumn.Column)
        originalColumnWidth = tempCol.ColumnWidth ' 元の列幅を保存
        cleanupTempSheet = False
    End If

    Dim lowCW As Double, highCW As Double, midCW As Double
    Dim currentPixelW As Double
    Dim bestFitCW As Double
    Dim minDiff As Double
    Dim iterations As Integer

    ' 初期化
    lowCW = 0
    highCW = 255 ' ColumnWidthの最大値
    
    ' 初期bestFitCWとminDiffを設定 (ColumnWidth = 0 の場合)
    tempCol.ColumnWidth = 0
    minDiff = Abs(tempCol.Width - targetPixelWidth)
    bestFitCW = 0

    ' ===== ステップ1: 粗い探索で適切な探索範囲 (lowCW, highCW) を見つける =====
    ' ColumnWidthを1.0ずつ増やして、targetPixelWidthを超えるか255になるまで探索
    Dim coarseStep As Double
    coarseStep = 1.0
    For midCW = 0 To highCW Step coarseStep
        tempCol.ColumnWidth = midCW
        currentPixelW = tempCol.Width
        
        If Abs(currentPixelW - targetPixelWidth) < minDiff Then
            minDiff = Abs(currentPixelW - targetPixelWidth)
            bestFitCW = midCW
        ElseIf Abs(currentPixelW - targetPixelWidth) = minDiff Then
            If midCW < bestFitCW Then ' 同じ差なら小さい方のColumnWidthを採用
                bestFitCW = midCW
            End If
        End If

        If currentPixelW >= targetPixelWidth Then
            highCW = midCW
            If midCW > coarseStep Then
                lowCW = midCW - coarseStep
            Else
                lowCW = 0
            End If
            Exit For ' 適切な範囲が見つかった
        End If
    Next midCW
    ' もしtargetPixelWidthが255の時のピクセル幅より大きい場合、highCWは255のまま、lowCWはその手前になる

    ' ===== ステップ2: 二分探索でより正確なColumnWidthを見つける =====
    iterations = 0
    Const MAX_ITERATIONS_BINARY As Integer = 100 ' 二分探索の最大繰り返し回数
    Const TOLERANCE_CW As Double = 0.0001       ' ColumnWidthの探索許容誤差

    Do While (highCW - lowCW) > TOLERANCE_CW And iterations < MAX_ITERATIONS_BINARY
        midCW = (lowCW + highCW) / 2
        tempCol.ColumnWidth = midCW
        currentPixelW = tempCol.Width

        If Abs(currentPixelW - targetPixelWidth) < minDiff Then
            minDiff = Abs(currentPixelW - targetPixelWidth)
            bestFitCW = midCW
        ElseIf Abs(currentPixelW - targetPixelWidth) = minDiff Then
            If midCW < bestFitCW Then ' 同じ差なら小さい方のColumnWidthを採用
                bestFitCW = midCW
            End If
        End If

        If currentPixelW < targetPixelWidth Then
            lowCW = midCW
        ElseIf currentPixelW > targetPixelWidth Then
            highCW = midCW
        Else ' ピクセル幅が完全に一致
            bestFitCW = midCW
            Exit Do
        End If
        iterations = iterations + 1
    Loop

    ' ===== ステップ3: 最終的な微調整 =====
    ' bestFitCWの近傍±0.01をチェック (ColumnWidthは通常小数点以下2桁で設定されるため)
    Dim candidateCW As Double
    Dim i As Long
    For i = -2 To 2 ' ±0.02の範囲を0.01刻みでチェック (例: bestFitCW-0.02, bestFitCW-0.01, bestFitCW, bestFitCW+0.01, bestFitCW+0.02)
        candidateCW = Round(bestFitCW + (i * 0.01), 2)
        
        If candidateCW < 0 Then candidateCW = 0
        If candidateCW > 255 Then candidateCW = 255
        
        tempCol.ColumnWidth = candidateCW
        currentPixelW = tempCol.Width
        
        If Abs(currentPixelW - targetPixelWidth) < minDiff Then
            minDiff = Abs(currentPixelW - targetPixelWidth)
            GetColumnWidthFromPixels = candidateCW ' 結果を直接代入
        ElseIf Abs(currentPixelW - targetPixelWidth) = minDiff Then
            If candidateCW < GetColumnWidthFromPixels Or GetColumnWidthFromPixels = 0 Then ' 同じ差なら小さい方のColumnWidthを採用 (初期値0も考慮)
                 If GetColumnWidthFromPixels = 0 And minDiff = Abs(0 - targetPixelWidth) And candidateCW <> 0 Then
                    '何もしない（bestFitCW=0が初期設定で、candidateCWがより適切な場合のみ更新）
                 ElseIf candidateCW < GetColumnWidthFromPixels Then
                    GetColumnWidthFromPixels = candidateCW
                 End If
                 ' 初回などでGetColumnWidthFromPixelsが未設定(0)の場合は、bestFitCWを使う
                 If iterations = 0 And i = -2 Then ' 最初のbestFitCWを設定
                    GetColumnWidthFromPixels = bestFitCW
                 End If

            End If
        End If
         ' 初回、またはより良い結果が見つかった場合の結果を保持
        If i = -2 Or Abs(currentPixelW - targetPixelWidth) <= minDiff Then ' <= で同じ場合も更新対象に
            If GetColumnWidthFromPixels = 0 And bestFitCW <> 0 Then ' 初期値が0でbestFitCWが見つかっている場合
                 GetColumnWidthFromPixels = bestFitCW
            End If
        End If
    Next i
    
    ' 最終的なbestFitCWを再評価 (ループで更新されなかった場合のため)
    tempCol.ColumnWidth = Round(bestFitCW,2)
    currentPixelW = tempCol.Width
    If Abs(currentPixelW - targetPixelWidth) < minDiff Then
        minDiff = Abs(currentPixelW - targetPixelWidth)
        GetColumnWidthFromPixels = Round(bestFitCW,2)
    ElseIf Abs(currentPixelW - targetPixelWidth) = minDiff Then
        If Round(bestFitCW,2) < GetColumnWidthFromPixels Then
            GetColumnWidthFromPixels = Round(bestFitCW,2)
        End If
    End If


    ' 後処理
    If cleanupTempSheet Then
        Application.DisplayAlerts = False
        ws.Delete
        Application.DisplayAlerts = True
    ElseIf Not refColumn Is Nothing Then
        tempCol.ColumnWidth = originalColumnWidth ' 元の列幅に戻す
    End If
    
    ' 最終結果を小数点以下2桁に丸める
    GetColumnWidthFromPixels = Round(GetColumnWidthFromPixels, 2)
    If GetColumnWidthFromPixels = 0 And targetPixelWidth > tempCol.Parent.StandardWidth / 2 Then ' 0だが明らかに幅が必要な場合、bestFitCWを再度評価
        If Round(bestFitCW,2) > 0 Then GetColumnWidthFromPixels = Round(bestFitCW,2)
    End If


End Function

' テスト用のSubプロシージャ
Sub TestGetColumnWidthFromPixels()
    Dim targetPixel As Double
    Dim calculatedColumnWidth As Double
    Dim testCol As Range
    Dim originalCW As Double

    ' --- テストケース ---
    ' アクティブシートのB列をテストに使用
    On Error Resume Next ' アクティブシートがない場合などを考慮
    Set testCol = ActiveSheet.Columns("B")
    If testCol Is Nothing Then
        MsgBox "テスト用のシートをアクティブにしてください。", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    
    originalCW = testCol.ColumnWidth ' 元の列幅を保存

    Debug.Print "標準フォント: " & Application.StandardFont & ", サイズ: " & Application.StandardFontSize
    Debug.Print "シートの標準文字幅 (ピクセル): " & ActiveSheet.StandardWidth
    Debug.Print "-----------------------------------------------------"

    Dim testPixels As Variant
    testPixels = Array(10, 25, 50, 75, 100, 150, 200, 300, ActiveSheet.StandardWidth) ' テストするピクセル幅の配列

    Dim i As Long
    For i = LBound(testPixels) To UBound(testPixels)
        targetPixel = CDbl(testPixels(i))
        
        ' 1. 指定した列で計算
        calculatedColumnWidth = GetColumnWidthFromPixels(targetPixel, testCol)
        
        Debug.Print "目標ピクセル幅 (B列使用): " & targetPixel
        Debug.Print "  計算されたColumnWidth: " & calculatedColumnWidth
        
        ' 検証: 計算されたColumnWidthを実際に設定してピクセル幅を確認
        testCol.ColumnWidth = calculatedColumnWidth
        Debug.Print "  設定後の実際のピクセル幅: " & testCol.Width & " (差: " & Round(testCol.Width - targetPixel, 3) & ")"
        Debug.Print "---"
    Next i

    ' 2. 一時シートを使用して計算 (refColumnを省略)
    targetPixel = 88 ' 例
    calculatedColumnWidth = GetColumnWidthFromPixels(targetPixel) ' refColumnを指定しない
    Debug.Print "目標ピクセル幅 (一時シート使用): " & targetPixel
    Debug.Print "  計算されたColumnWidth: " & calculatedColumnWidth
    ' この場合、実際のピクセル幅を確認するには、関数内でDebug.Printするか、
    ' 手動で新しいシートに設定して確認する必要があります。
    Debug.Print "-----------------------------------------------------"

    testCol.ColumnWidth = originalCW ' テスト列の幅を元に戻す
    MsgBox "テストが完了しました。イミディエイトウィンドウで結果を確認してください。", vbInformation
End Sub

コードの解説

1. GetColumnWidthFromPixels 関数:

   • 引数として targetPixelWidth (目標のピクセル幅) と、オプションで refColumn (基準とする列) を取ります。refColumn を省略すると、新しい一時的なワークシートが作成され、そのA列で計算が行われた後、シートは削除されます。
   • まず、ColumnWidth を0から255の範囲で大まかに探索し (ステップ1)、targetPixelWidth に近い値の探索範囲を絞り込みます。
   • 次に、絞り込んだ範囲内で二分探索を行い (ステップ2)、より精密に targetPixelWidth に最も近い ColumnWidth を見つけます。
   • 最後に、見つかった ColumnWidth の近傍（±0.01、±0.02など）をチェックし (ステップ3)、最も誤差の少ない値を最終結果とします。これは ColumnWidth が通常小数点以下2桁で扱われること、およびピクセルへの変換が完全に滑らかではない場合があるためです。
   • 途中でピクセル差が同じだった場合は、より小さい ColumnWidth を優先するようにしています。
   • 結果は小数点以下2桁に丸められます。

2. TestGetColumnWidthFromPixels サブプロシージャ:

   • 上記の関数をテストするためのサンプルコードです。
   • いくつかの異なるピクセル幅に対して GetColumnWidthFromPixels を呼び出し、計算された ColumnWidth と、その ColumnWidth を実際に列に設定したときのピクセル幅をイミディエイトウィンドウに出力します。

使用方法

1. Excelを開き、Alt + F11 を押してVBEを開きます。
2. VBEのメニューから 挿入 > 標準モジュール を選択します。
3. 表示されたモジュールウィンドウに上記のVBAコード全体をコピー＆ペーストします。
4. TestGetColumnWidthFromPixels サブプロシージャを実行して動作を確認できます。VBE内でカーソルを TestGetColumnWidthFromPixels の中に置き、F5 キーを押すか、実行ボタン（緑色の三角）をクリックします。結果はイミディエイトウィンドウ (Ctrl + G で表示) に出力されます。
5. 自分のVBAプロジェクトから GetColumnWidthFromPixels 関数を呼び出すには、以下のようにします。

   Dim desiredPixels As Double
   Dim colWidth As Double
   
   desiredPixels = 120 ' 例えば120ピクセルにしたい
   colWidth = GetColumnWidthFromPixels(desiredPixels, ActiveSheet.Columns("C")) ' C列を基準にする場合
   ' または
   ' colWidth = GetColumnWidthFromPixels(desiredPixels) ' 一時シートで計算する場合
   
   ActiveSheet.Columns("C").ColumnWidth = colWidth
   

注意点

• 精度: この方法は近似値を求めるものです。ピクセル値は整数（または環境により細かい小数）ですが、ColumnWidth は小数点以下2桁程度で丸められることが多く、完全に一致する ColumnWidth が存在しない場合があります。関数は最も近い値を探します。
• 環境依存性: 列のピクセル幅は、使用している標準フォント、フォントサイズ、WindowsのDPI（画面の解像度スケーリング）設定によって変わります。このため、ある環境で得られた ColumnWidth が別の環境で同じピクセル幅になるとは限りません。
• パフォーマンス: 関数内で列幅を何度も変更するため、大量の列に対して頻繁に呼び出すとパフォーマンスに影響が出る可能性があります。

このVBAコードを使用することで、プログラム的にピクセル幅から ColumnWidth を逆算する処理を実装できるはずです。