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

[WhoamI]

Cảm ơn bác anhtuan1066 rất nhiều vì đã chia sẻ công cụ hữu ích giúp cho mọi người. Em đã chạy thử và cũng như bác hoquanghoa12c3, em thấy rất tốt nhưng vẫn còn mấy hạn chế như sau :

1. Đối với các dòng, cột có sẵn trong bàng tính thì không giúp tự động điều chỉnh độ cao của dòng.
2. Không áp dụng được với single cell
3. Đối với 1 dòng nhập nhiều ký tự một chút thì khi view lên để in thấy ko hiển thị được hết các ký tự cuối của dòng đó (lỗi này chắc do cách đếm ký tự của Excel ko chuẩn???)

Rất mong các bác tiếp tục bàn luận để xử lý các hạn chế trên để phát triển công cụ của bác anhtuan1066 thành 1 tool hoàn thiện và hữu ích hơn cho việc xử lý văn bản trên excel.

 

[thangcola113]

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:

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

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

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ờ các bác tăng tốc giùm em đoạn code trên.
code chạy rất tốt nhưng hơi chậm, nếu sử dụng trong nhiều hàng thì chạy lâu nên ảnh hưởng đến công việc.
Thanks

 

[ndunghuong]

Trước hết xin cảm ơn bác anhtuan đã chia sẻ code
Nhưng dường như code này chỉ dùng được khi ta gõ trực tiếp vào ô, còn nếu ô đó là hàm liên kết từ ô khác thì lúc được lúc không (tôi đã thử thì thấy khi dữ liệu 2 hàng thì được, nhưng nếu lên 3 hàng thì không hiệu quả)

 

[nguyennguyet3001]

Khi tăng độ rộng của hàng rồi, mình muốn sửa lại text ngắn lại thì lại không tự động thu nhỏ lại bạn ơi

 

[be_09]

Nếu không sử dụng code, thì tôi làm như thế này:

Ở đầu bảng chọn tất cả các dòng cần cho nó nhảy lên hoặc nhảy xuống, click phải chuột chọn Format Cells..., cửa sổ Format Cells hiện ra, click vào thẻ Alignment sau đó đánh dấu chọn vào Wrap text và nhấn OK, tiếp theo rê vào mép lưới (Gridlines) khi thấy hình chữ thập đen đậm thì nhấp đúp chuột vào lưới, vậy là tất cả các Cell đồng loạt nằm vừa khít trong ô lưới.

 

[lacbuidoi]

- Mình cũng "mò" được cái này trên mạng, thấy cũng có vẽ ổn, các bạn xem thử

 

[hung2412]

- Mình cũng "mò" được cái này trên mạng, thấy cũng có vẽ ổn, các bạn xem thử

Cảm ơn bạn rất nhiều vì đã share, mình đã lập hẳn topic hỏi vấn đề này mà chưa có vị nào hướng dẫn, cứ như là chết đuối vớ được cọc. Cuộc sống thật kỳ diệu.

 

[tunghanhvn1]

- Mình cũng "mò" được cái này trên mạng, thấy cũng có vẽ ổn, các bạn xem thử

trên file của bạn mình sử dụng được,
làm sao để sử dụng trên file của mình?

Mình chỉ sử dụng excel để tính toán và sử dụng một số lệnh cơ bản.
cảm ơn bạn !

 

[langtuchungtinh360]

trên file của bạn mình sử dụng được,
làm sao để sử dụng trên file của mình?

Mình chỉ sử dụng excel để tính toán và sử dụng một số lệnh cơ bản.
cảm ơn bạn !

copy code từ file bạn ấy qua file của bạn là dùng được ak.

 

[huuthang_bd]

copy code từ file bạn ấy qua file của bạn là dùng được ak.

Dùng code đó có khi trớt quớt.

 

[emconnhaxd]

Bác nào giúp em với. Khi em dùng lệnh link để xuất dữ liệu khì chỗ dòng lệnh đó chứ không tự động auto chiều cao nó toàn khuất chữ hoặc dòng quá cao
. Bác nào có file làm được rồi hoặc cho em xin ty zalo em hỏi ty. em vướng nhất chỗ này đó

 

[emconnhaxd]

File của em nè. các bác giúp với

 

[langtuchungtinh360]

File của em nè. các bác giúp với

http://www.giaiphapexcel.com/forum/...ng-cho-vừa-ô-cần-căn-link-công-thức-từ-ô-khác

 

[dangky47h]

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:

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

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

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

Anh ơi, khi E chạy code thì nó báo đoạn code màu đỏ là do lỗi gì vậy ạ! Cám ơn Anh

 

[hhoang_56]

Anh ơi, khi E chạy code thì nó báo đoạn code màu đỏ là do lỗi gì vậy ạ! Cám ơn Anh
View attachment 199091

Hình như chữ Sub bạn copy bị thiếu chữ S

 

[dangky47h]

Hình như chữ Sub bạn copy bị thiếu chữ S

mình coppy đủ rồi nhưng k thấy báo gì bạn ạ, bạn giúp mình, mình copy code vao module ma chạy k thấy gì

 

[hhoang_56]

mình coppy đủ rồi nhưng k thấy báo gì bạn ạ, bạn giúp mình, mình copy code vao module ma chạy k thấy gìView attachment 199097

còn cái này thì sao???

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

 

[dangky47h]

còn cái này thì sao???

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

Anh có thể gửi lại cho e xin bản code đầy đủ được k ạ! e k hiểu ý anh

 

[hhoang_56]

Anh có thể gửi lại cho e xin bản code đầy đủ được k ạ! e k hiểu ý anh

File đây

 

[dangky47h]

File đây

Vâng Cám ơn Anh, Em xem qua thì thấy
1. Đoạn code dài thì được đưa vào module của cả file
2. Đoạn code ngắn thì đưa vào sheet nào muốn điều chỉnh độ cao của dòng
Đúng k ạ!