Установите ширину столбцов одного листа так же, как и другой.

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

Я хотел бы: - Скопируйте всю строку Лист1 - Специальная вставка, ширину столбцов на других листах:

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