Tự động điều chỉnh độ cao của dòng (6 người xem)

Nguyễn Xuân Sơn · 14/12/07

Chào các bạn!
Tôi hay phải làm báo cáo có cả lời văn và bảng biểu, bởi vậy tôi thường làm trên Excel. Để viết lời văn tôi sát nhập các ô cùng dòng cho bằng độ rộng khổ giấy và dùng chức năng wraptext để xuống hàng, dùng chức năng canh đều để chỉnh chữ ngay ngắn và kéo giãn biên độ cao của dòng để các hàng khỏi bị che khuất. Như phải vậy mất một số thao đáng kể để điều chỉnh cho thích hợp.
Nếu có cách nào mà khi ta "cứ đánh tràn" như trong word mà nó tự động giãn độ cao của dòng vừa đủ các hàng thì tiện lợi quá.
vậy xin các bạn giải quyết hộ tôi vấn đề này với.
( Có fai minh họa gửi kèm dưới đây )

Xin cảm ơn các bạn nhé!

anhtuan1066 · 14/12/07

Nếu là 1 cell đơn thì dễ... còn với merged cells thì hơi khó 1 chút...
Tôi có tham khảo cách làm trên trang web nước ngoài và chỉnh sửa lại 1 chút:

PHP:

Sub AutoFitMergedCellRowHeight(Target As Range)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range, RangeWidth As Single
    Dim TargetWidth As Single, PossNewRowHeight As Single
    If Target.MergeCells Then
        With Target.MergeArea
                .WrapText = True
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlCenter
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                TargetWidth = Target.ColumnWidth
                RangeWidth = .Width
                 
                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                 
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                 
                While .Cells(1).Width < RangeWidth
                    .Cells(1).ColumnWidth = .Cells(1).ColumnWidth + 0.5
                Wend
                 
                .Cells(1).ColumnWidth = .Cells(1).ColumnWidth - 0.5
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = TargetWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
        End With
    End If
End Sub

---------------------

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
    Call AutoFitMergedCellRowHeight(Target)
End Sub

Các bạn xem lại có chổ nào trục trặc ko nha! Tôi mới test sơ qua, chưa thấy vấn đề gì nhưng cũng ko dám chắc chắn
ANH TUẤN

anhtuan1066 · 14/12/07

Tôi test ko có vấn đề gì cả...
Bạn chú ý là code này chỉ có tác dụng với những cell đã dc merge nhé (merge theo chiều ngang... ví dụ A1, B1, C1 merge với nhau)...
Vì làm cái này với cell đơn thì quá dễ dàng mà... Merged cells mới khó

Nguyễn Xuân Sơn · 14/12/07

Bác AnhTuan ơi tôi cũng thử rồi nhưng mà ko chạy dc. Vậy bác vui lòng up fai mà bác tes lên cho bọn tôi xem với.

tigertiger · 15/12/07

Vẫn chạy tốt đó bạn - vấn đề là ở Sheet bạn bấm Alt+F11 rồi bấm vào tên Sheet (chẳng hạn Sheet1) - sau đó chép code trên vào. Và lưu ý atuan đã viết:

ạn chú ý là code này chỉ có tác dụng với những cell đã dc merge nhé (merge theo chiều ngang... ví dụ A1, B1, C1 merge với nhau)...

Có nghĩa là bạn thử với cell đơn sẽ ko có t/d đâu

anhtuan1066 · 15/12/07

Tôi gữi file lên luôn đây! Trong file hảy nhập text vào các cell màu vàng... (Nói chung là cell nào đã dc merge)
File này vẫn còn lỗi, nhờ các cao thủ sửa giúp (ví dụ xóa dử liệu trong cell sẽ lỗi)
ANH TUẤN

Tiger62 · 15/12/07

Bạn Sơn ơi ! mẹo đơn giản lắm, chỉ cần mở 1 file word rồi insert 1 table sau đó ta coppy sang file excel thế là ta có những ô như ý bạn rồi, đó là word in excel và ngược lại ta cũng có excel in word nếu ta không dùng chức năng insert 1 table Sheet trong word.

anhtuan1066 · 16/12/07

Tiger62 đã viết:
Bạn Sơn ơi ! mẹo đơn giản lắm, chỉ cần mở 1 file word rồi insert 1 table sau đó ta coppy sang file excel thế là ta có những ô như ý bạn rồi, đó là word in excel và ngược lại ta cũng có excel in word nếu ta không dùng chức năng insert 1 table Sheet trong word.

Ở đây người ta cần tự động mà bạn

Nguyễn Xuân Sơn · 16/12/07

Cảm ơn bác AnhTuan nhé, Tôi không để ý cái lệnh gọi riêng Private nên không chạy được. Giờ thì Ngon rồi. Thật tuyệt, với cod này mà áp dụng làm báo cáo thì làm trên EX tiện dụng lắm.Các bạn khác cũng áp dụng thử xem, Tuyệt lắm.

anhtuan1066 · 17/12/07

Tuy nhiên như tôi đã nói ở trên: Code vẫn còn lỗi đấy, merge A1 và A2 thử thì biết...
Các bạn đóng góp ý kiến sửa lỗi giùm nhé!
ANH TUẤN

vuha · 19/12/08

Xin lỗi các bạn, tôi xin chen ngang chủ đề 1 tí

anhtuan1066 đã viết:

Nếu là 1 cell đơn thì dễ... còn với merged cells thì hơi khó 1 chút...
Tôi có tham khảo cách làm trên trang web nước ngoài và chỉnh sửa lại 1 chút:

PHP:

Sub AutoFitMergedCellRowHeight(Target As Range)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range, RangeWidth As Single
    Dim TargetWidth As Single, PossNewRowHeight As Single
    If Target.MergeCells Then
        With Target.MergeArea
                .WrapText = True
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlCenter
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                TargetWidth = Target.ColumnWidth
                RangeWidth = .Width
 
                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
 
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
 
                While .Cells(1).Width < RangeWidth
                    .Cells(1).ColumnWidth = .Cells(1).ColumnWidth + 0.5
                Wend
 
                .Cells(1).ColumnWidth = .Cells(1).ColumnWidth - 0.5
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = TargetWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
        End With
    End If
End Sub

---------------------

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
    Call AutoFitMergedCellRowHeight(Target)
End Sub

Các bạn xem lại có chổ nào trục trặc ko nha! Tôi mới test sơ qua, chưa thấy vấn đề gì nhưng cũng ko dám chắc chắn
ANH TUẤN

Trong chủ đề dưới đây, tôi có nhờ các bạn giúp code autofilter và autofit rồi print all. Bác Boyxin đã chỉ cho tôi kiếm trên mạng và tôi đã thấy chủ đề này, tôi nhờ bạn đọc và chỉ giúp với. Nếu được thì giúp tôi ghép mấy đoạn code ấy lại cho hoàn chỉnh vì VBA tôi mù tịt. Thanks.
http://www.giaiphapexcel.com/forum/showthread.php?t=17333
P/S: Tôi không biết cách trích câu hỏi của tôi và trả lời của boyxin nên phiền bạn đọc cả đề tài trên vậy nhé. Thanks.

thao_giabinhbn · 14/3/09

hic,mình thì rất gà về cái này,chẳng hiểu phải làm thế nào nữa.Nhưng mình thử file kia thì không thấy chạy theo ý muốn

leviethungtoht · 25/2/11

Sub AutoFitMergedCellRowHeight(Target As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range, RangeWidth As Single
Dim TargetWidth As Single, PossNewRowHeight As Single
On Errors GoTo Thoat
If (Target.MergeCells And (Target.Text <> "")) Then ' ban sua dieu kien la duoc
With Target.MergeArea
.WrapText = True
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
TargetWidth = Target.ColumnWidth
RangeWidth = .Width

For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next

.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth

While .Cells(1).Width < RangeWidth
.Cells(1).ColumnWidth = .Cells(1).ColumnWidth + 0.5
Wend

.Cells(1).ColumnWidth = .Cells(1).ColumnWidth - 0.5
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = TargetWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
End With
End If
Thoat:
End Sub

Nguyễn Xuân Sơn · 26/9/11

anhtuan1066 đã viết:

Nếu là 1 cell đơn thì dễ... còn với merged cells thì hơi khó 1 chút...
Tôi có tham khảo cách làm trên trang web nước ngoài và chỉnh sửa lại 1 chút:

PHP:

Sub AutoFitMergedCellRowHeight(Target As Range)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range, RangeWidth As Single
    Dim TargetWidth As Single, PossNewRowHeight As Single
    If Target.MergeCells Then
        With Target.MergeArea
                .WrapText = True
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlCenter
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                TargetWidth = Target.ColumnWidth
                RangeWidth = .Width
                 
                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                 
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                 
                While .Cells(1).Width < RangeWidth
                    .Cells(1).ColumnWidth = .Cells(1).ColumnWidth + 0.5
                Wend
                 
                .Cells(1).ColumnWidth = .Cells(1).ColumnWidth - 0.5
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = TargetWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
        End With
    End If
End Sub

---------------------

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
    Call AutoFitMergedCellRowHeight(Target)
End Sub

Các bạn xem lại có chổ nào trục trặc ko nha! Tôi mới test sơ qua, chưa thấy vấn đề gì nhưng cũng ko dám chắc chắn
ANH TUẤN

Chào các bạn,

Quay lại chủ đề "Tự động giãn độ cao của dòng"

Tôi xin được anh: anhtuan1066 và các bạn giúp xử lý thêm một giả thiết sau:

Vì tình huốn của đề tài là tự động giãn độ cao của dòng với các ô được sát nhập. Nay giả sử nếu ta cứ đánh ký tự vào ô bất kỳ ( không kể ô đó là có sát nhập hay không ) mà nó vẫn tự động giãn độ cao của dòng thì ta phải làm thế nào.

Vậy xin các bạn giúp đỡ nhé.

Cảm ơn các bạn

ngocvtu · 22/11/11

Bạn tuấn ơi cho mình hỏi
file của bạn gửi làm sao để chạy được
Bạn tuấn ơi, file của bạn auotfit khi đưa chuột vào giữa 2 hàng nhấp chuôt thì hàng merge vẫn nhảy về 1 dòng với phần chữ bị che đi

gakon_Office · 7/12/11

Xin lỗi!
Nếu mà tự động giãn độ cao dòng của một ô đơn thì làm thế nào ạ!
Em định dạng ở chế độ auto rồi nhưng đôi lúc gặp phải trường hợp không tự động giãn hết.
Xin GPE cho em một code về Cell đơn của cả file.

rickypham · 24/4/12

Hi các anh chị, cách của anh Anh Tuấn em có làm thử thì thấy OK nhưng có cách nào khi mình gõ cũng tại ô đó đã giãn ra thành 2 hoặc 3 dòng rồi. Đến lúc mình gõ nội dung khác ngắn hơn vào lại ô đó thì nó tự động co lại không nhỉ.
Vì em test thử thì chỉ thấy nó giãn ra thôi ạ chứ không tự co lại khi xóa bớt chữ đi.
Em xin cám ơn

hoquanghoa12c3 · 25/4/12

Cảm ơn các bạn đã tham gia đề tài này. mình đã dùng thử rất tốt. Mình mong các bạn mở rộng thêm một tí nữa đc ko? Vì hiện tại với cách xử lý theo bạn ANH TUAN mới áp dụng cho từng lần nhập rồi Enter thì sẽ tự động điều chỉnh độ cao của dòng. Mình muốn là các dòng có sẳn trong bàng tính tự động điều chỉnh độ cao của dòng. Rất mong được các bạn hổ trợ. Chân thành cảm ơn

Chutmayman · 13/9/12

Nếu các bác dùng excel 2007 trở về sau thì kích nút Format trên nhóm Cells của tab Home rồi sử dụng tính năng AutoFit, kích vào AutoFit Row Height hoặc AutoFit Column Width là sẽ được.

LinDan · 9/3/13

anhtuan1066 đã viết:

Nếu là 1 cell đơn thì dễ... còn với merged cells thì hơi khó 1 chút...
Tôi có tham khảo cách làm trên trang web nước ngoài và chỉnh sửa lại 1 chút:

PHP:

Sub AutoFitMergedCellRowHeight(Target As Range)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range, RangeWidth As Single
    Dim TargetWidth As Single, PossNewRowHeight As Single
    If Target.MergeCells Then
        With Target.MergeArea
                .WrapText = True
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlCenter
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                TargetWidth = Target.ColumnWidth
                RangeWidth = .Width
                 
                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
                Next
                 
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                 
                While .Cells(1).Width < RangeWidth
                    .Cells(1).ColumnWidth = .Cells(1).ColumnWidth + 0.5
                Wend
                 
                .Cells(1).ColumnWidth = .Cells(1).ColumnWidth - 0.5
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = TargetWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
        End With
    End If
End Sub

---------------------

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
    Call AutoFitMergedCellRowHeight(Target)
End Sub

Các bạn xem lại có chổ nào trục trặc ko nha! Tôi mới test sơ qua, chưa thấy vấn đề gì nhưng cũng ko dám chắc chắn
ANH TUẤN

Em cảm ơn thày Tuấn rất nhiều. Tuy nhiên, code em vẫn chưa thạo lắm, em chưa hiểu tại sao lại có +0.5 và -0.5 để làm gì ah?

Tự động điều chỉnh độ cao của dòng (6 người xem)

Người dùng đang xem chủ đề này

Thành viên thường trực

File đính kèm

Thành viên gạo cội

Thành viên gạo cội

Thành viên thường trực

Coming back ...

Thành viên gạo cội

File đính kèm

Thành viên hoạt động

Thành viên gạo cội

Thành viên thường trực

Thành viên gạo cội

Thành viên hoạt động

Thành viên mới

Thành viên mới

Thành viên thường trực

Thành viên mới

Nguyễn Hoàng Nhi

Thành viên hoạt động

Thành viên mới

Thành viên mới

Thành viên tiêu biểu

Đếm ngược thời gian