Nhờ tạo giúp hàm TỰ ĐỘNG ĐIỀU CHỈNH ĐỘ RỘNG HÀNG ! (2 người xem)

[quygha2007]

- Em có 1 file gồm nhiều sheet, nhờ các anh/chị tạo giúp hàm tự động dãn độ rộng của hàng 1 trong sheet QD Cap ở file đính kèm với. thanks

 

[hoangquanghn]

Gửi bạn File đã chạy code ok. bạn chạy marco dong

 

[langtuchungtinh360]

- Em có 1 file gồm nhiều sheet, nhờ các anh/chị tạo giúp hàm tự động dãn độ rộng của hàng 1 trong sheet QD Cap ở file đính kèm với. thanks

bạn sử dụng code này xem

'Tac gia: anhtuan1066
'Bien soan chinh sua lai: Hoang Trong Nghia
'Nguon  : giaiphapexcel
Sub MergeCellFit(ByVal MergeCells As Range)    '<= fix chiê?u cao ô Merge
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim Diff As Single
    Dim FirstCell As Range, MergeCellArea As Range
    Dim Col As Long, ColCount As Long, RowCount As Long
    Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As _
            Double
    If MergeCells.Count = 1 Then
        Set MergeCellArea = MergeCells.MergeArea
    Else
        Set MergeCellArea = MergeCells
    End If
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With MergeCellArea
        ColCount = .Columns.Count
        RowCount = .Rows.Count
        .VerticalAlignment = xlTop
        .WrapText = True
        If RowCount = 1 And ColCount = 1 Then
            .EntireRow.AutoFit
            GoTo ExitSub
        End If
        Set FirstCell = .Cells(1, 1)
        FirstCellWidth = FirstCell.ColumnWidth
        Diff = 0.75
        For Col = 1 To ColCount
            MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
        Next
        .MergeCells = False
        FirstCell.ColumnWidth = MergeCellWidth - Diff
        .EntireRow.AutoFit
        FirstCellHeight = FirstCell.RowHeight + 3
        .MergeCells = True
        FirstCell.ColumnWidth = FirstCellWidth
        FirstCellHeight = FirstCellHeight / RowCount
        .RowHeight = FirstCellHeight
    End With
ExitSub:
    Application.Calculation = xlCalculationAutomatic
    FirstCell = Nothing
    Application.EnableEvents = True
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

cách dùng MergeCellFit <địa chỉ ô cần fix>
ví dụ MergeCellFit [A1]
có thể cho vào sự kiện của sheet để chạy tự động

Gửi bạn File đã chạy code ok. bạn chạy marco dong

chả thấy chạy gì cả

 

[hoangquanghn]

không biết sử dụng thì có tui thấy vẫn chạy chuẩn