excel - 将一张纸的列宽设置为与另一张相同

Question

我正在尝试编写代码，将一张工作表中的列宽设置为与另一张工作表中的列宽相同。它并没有我想象的那么简单，所以我将它张贴在这里，试图确定它是否可以以更简单的方式完成。

似乎当我读取一张工作表中的列宽时，为了设置另一张工作表中的列宽，我必须添加一个校正因子以获得正确的宽度。校正因子为 (ReadWidth/0.75 - 5)/7。

我使用的代码如下:

Function SetWidths()
Dim Cntr As Integer, Column As String, Sht1 As String, Sht2 As String
Dim Sht1Wid As Double, Sht2Wid As Double, Sht1WidSet As Double, Sht2WidSet As Double

Sht1 = "Sheet1"
Sht2 = "Sheet2"

For Cntr = 1 To 55

    Column = Num2Col(Cntr)

    Sht1Wid = Worksheets(Sht1).Range(Column & "1").Width                ' read width
    Sht2Wid = Worksheets(Sht2).Range(Column & "1").Width
    Sht1WidSet = (Sht1Wid / 0.75 - 5) / 7                               ' correction factor
    Sht2WidSet = (Sht2Wid / 0.75 - 5) / 7

    If Sht1Wid <> Sht2Wid Then
        If Sht1Wid > Sht2Wid Then                                       ' set width to largest
            Worksheets(Sht2).Columns(Column).ColumnWidth = Sht1WidSet
        Else
            Worksheets(Sht1).Columns(Column).ColumnWidth = Sht2WidSet
        End If
    End If

Next Cntr

End Function

Num2Col 是另一个函数，它根据数字返回列的字符串。

有没有人有更简单的方法来做到这一点？必须添加校正因子似乎很奇怪。

Answer 1

我会:- 复制整行 Sheet1- 将特殊的列宽粘贴到其他工作表上:

Sub AdjustColumns()
    Dim oSh As Worksheet
    Worksheets(1).Range("1:1").Copy
    For Each oSh In Worksheets
        If oSh.Index > 1 Then
            .PasteSpecial Paste:=xlPasteColumnWidths
        End If
    Next
End Sub