Xin mã code autofit (1 người xem)

[nghiahandsome1995]

Xin chào mọi người, em muốn xin 1 mã code autofit tại ô A1 sao cho Khi ô F1=1 thì chiều cao hàng ngang ô A1 bằng chiều cao hàng ngang ô B1+B2+B3,Khi ô F1=2 thì chiều cao hàng ngang ô A1 bằng chiều cao dữ liêụ nhập (mọi người xem file đính kèm), xin trân trọng cảm ơn mọi người !

 

[yaaasoo01]

Hi bro,
Mình thấy bạn đã merge vào rồi thì lúc nào chiều cao ô A1 cũng bằng B1+B2+B3 mà nhỉ?

 

[nghiahandsome1995]

Hi bro,
Mình thấy bạn đã merge vào rồi thì lúc nào chiều cao ô A1 cũng bằng B1+B2+B3 mà nhỉ?

nhưng khi ô A1 nó nhiều chữ lên thì lúc này phải kéo ô A1 rộng ra để nó đủ chữ ông à, mà cái đó mình không biết làm VBA, chỉnh tay thì rất mất thời gian

 

[truongvu317]

Hi bro,
Mình thấy bạn đã merge vào rồi thì lúc nào chiều cao ô A1 cũng bằng B1+B2+B3 mà nhỉ?

Chỉnh cột a,sau đó phân bổ chiều cao đều cho các ở cột B?

 

[yaaasoo01]

nhưng khi ô A1 nó nhiều chữ lên thì lúc này phải kéo ô A1 rộng ra để nó đủ chữ ông à, mà cái đó mình không biết làm VBA, chỉnh tay thì rất mất thời gian

Bạn tham khảo bài viết này: https://stackoverflow.com/questions/48245163/excel-vba-autofit-merged-cells

Sub test()
    Call AutoFitMergedCells(Range("A1:A3"))
End Sub


Public Sub AutoFitMergedCells(oRange As Range)
  Dim tHeight As Integer
  Dim iPtr As Integer
  Dim oldWidth As Single
  Dim oldZZWidth As Single
  Dim newWidth As Single
  Dim newHeight As Single
  With Sheets("Sheet1")
    oldWidth = 0
    For iPtr = 1 To oRange.Columns.Count
      oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
    Next iPtr
    oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth
    oRange.MergeCells = False
    newWidth = Len(.Cells(oRange.Row, oRange.Column).Value)
    oldZZWidth = .Range("ZZ1").ColumnWidth
    .Range("ZZ1") = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
    .Range("ZZ1").WrapText = True
    .Columns("ZZ").ColumnWidth = oldWidth
    .Rows("1").EntireRow.AutoFit
    newHeight = .Rows("1").RowHeight / oRange.Rows.Count
    .Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
    oRange.MergeCells = True
    oRange.WrapText = True
    .Range("ZZ1").ClearContents
    .Range("ZZ1").ColumnWidth = oldZZWidth
  End With
End Sub