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

将一个工作表的列宽设置为与另一个工作表相同

1 个答案: