Tự động điều chỉnh độ cao của dòng

Liên hệ QC
N

Nguyễn Xuân Sơn

Thành viên thường trực
Tham gia
23/4/07
Bài viết
343
Được thích
219
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é!
 

File đính kèm

  • BCHOATDONG.rar
    18.6 KB · Đọc: 723
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
 
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ó
 
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.
 
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)...
Nhấp chuột vào đây để mở rộng...

Có nghĩa là bạn thử với cell đơn sẽ ko có t/d đâu
 
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
 

File đính kèm

  • AutoFit.zip
    8.6 KB · Đọc: 1,353
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.
 
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.
Nhấp chuột vào đây để mở rộng...
Ở đây người ta cần tự động mà bạn
 
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.
 
Lần chỉnh sửa cuối:
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
 
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
Nhấp chuột vào đây để mở rộng...
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.
 
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
 
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
 
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
Nhấp chuột vào đây để mở rộng...

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
 
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
 
Lần chỉnh sửa cuối:
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.
 
Hi các anh chị, cách của anh Anh Tuấn em có làm thử thì thấy OK nhưng có cách nào khi mình gõ cũng tại ô đó đã giãn ra thành 2 hoặc 3 dòng rồi. Đến lúc mình gõ nội dung khác ngắn hơn vào lại ô đó thì nó tự động co lại không nhỉ.
Vì em test thử thì chỉ thấy nó giãn ra thôi ạ chứ không tự co lại khi xóa bớt chữ đi.
Em xin cám ơn
 
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
 
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.
 
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
Nhấp chuột vào đây để mở rộng...

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?
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

A
Excel thiếu dữ liệu
Trả lời
4
Đọc
95
Mr.hieudoanxd
Mr.hieudoanxd
H
  • Question
Code subtotal và tìm điều kiện
Trả lời
11
Đọc
190
Hoàng Tuấn 868
H
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
1
Đọc
39
BuiQuangThuan
B
A
Đếm dữ liệu với điều kiện
Trả lời
11
Đọc
101
DeTong
D
Maika8008
  • Question
Add-In .xlam trộn dữ liệu Excel vào Word
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
29
Đọc
2K
vu_tuan_manh_linh
vu_tuan_manh_linh
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom