Tự động điều chỉnh row trong EX

[nam739478]

chào các pac cao thủ
em có vấn đề này nữa nhờ các cao thủ Excel giúp cho
em co file đình kèm

 

[nam739478]

không có ai giup đỡ tôi vấn đề này được ah`
hic hic ..................
mong hoài!

 

[ndu96081631]

chào các pac cao thủ
em có vấn đề này nữa nhờ các cao thủ Excel giúp cho
em co file đình kèm

Xem bài này:
http://www.giaiphapexcel.com/forum/showthread.php?6773-Tự-động-điều-chỉnh-độ-cao-của-dòng
Chỉ có thể giải quyết bằng VBA thôi

 

[siwtom]

Xem bài này:
http://www.giaiphapexcel.com/forum/showthread.php?6773-Tự-động-điều-chỉnh-độ-cao-của-dòng
Chỉ có thể giải quyết bằng VBA thôi

Ở bài #6 trong link trên Tuấn có viết: "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)"

Ý Tuấn là thế nào? Là khi xóa dữ liệu thì dòng không co lại? Tức không có error mà lỗi ở đây hàm ý là dòng không co lại như ý ta?

 

[ndu96081631]

Ở bài #6 trong link trên Tuấn có viết: "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)"

Ý Tuấn là thế nào? Là khi xóa dữ liệu thì dòng không co lại? Tức không có error mà lỗi ở đây hàm ý là dòng không co lại như ý ta?

Bài viết ấy từ năm 2007 lận anh à!
Khi ấy em chưa biết gì về VBA nên code AutoFit cũng là COPY của người ta về xài chứ chưa hiểu gì
Còn bây giờ thì... Ẹc... Ẹc... em tự tin có thể viết ngon lành hơn code gốc ấy đấy

 

[siwtom]

Còn bây giờ thì... Ẹc... Ẹc... em tự tin có thể viết ngon lành hơn code gốc ấy đấy

Thế thì tôi gặp đúng người rồi.
Nhờ Tuấn cho ý kiến, code tôi viết có gì sai sót không.

[GPECODE=vb]
Sub AutoFitMergedCellRowHeight(Target As Range)
Dim RangeWidth As Single
Dim OldColumnWidth As Single, CalcRowHeight As Single, rng As Range
If Target.MergeCells Then
Application.ScreenUpdating = False
Set rng = Target.MergeArea
With Target.MergeArea
.WrapText = True
.HorizontalAlignment = xlGeneral
OldColumnWidth = Target.ColumnWidth
RangeWidth = .Width
.MergeCells = False
Target.ColumnWidth = Target.ColumnWidth * RangeWidth / Target.Width
.EntireRow.AutoFit
CalcRowHeight = .RowHeight
Target.ColumnWidth = OldColumnWidth
.MergeCells = True
.RowHeight = CalcRowHeight
End With
If Not Target.MergeCells Then rng.Merge
Application.ScreenUpdating = True
End If
End Sub
[/GPECODE]

 

[ndu96081631]

Thế thì tôi gặp đúng người rồi.
Nhờ Tuấn cho ý kiến, code tôi viết có gì sai sót không.

[GPECODE=vb]
Sub AutoFitMergedCellRowHeight(Target As Range)
Dim RangeWidth As Single
Dim OldColumnWidth As Single, CalcRowHeight As Single, rng As Range
If Target.MergeCells Then
Application.ScreenUpdating = False
Set rng = Target.MergeArea
With Target.MergeArea
.WrapText = True
.HorizontalAlignment = xlGeneral
OldColumnWidth = Target.ColumnWidth
RangeWidth = .Width
.MergeCells = False
Target.ColumnWidth = Target.ColumnWidth * RangeWidth / Target.Width
.EntireRow.AutoFit
CalcRowHeight = .RowHeight
Target.ColumnWidth = OldColumnWidth
.MergeCells = True
.RowHeight = CalcRowHeight
End With
If Not Target.MergeCells Then rng.Merge
Application.ScreenUpdating = True
End If
End Sub
[/GPECODE]

Ta biết rằng với 1 cell bình thường (không merge) thì khi Wraptext, chiều cao dòng sẽ tự chỉnh
Từ tính chất đó, em sẽ làm như sau:
- Tính chiều rộng của cell đang merge là bao nhiêu, ghi vào biến nhớ
- Bỏ merge cell, chỉnh lại chiều rộng của cell bằng đúng với chiều rộng đã nhớ
- Thiết lập Wraptext để cell tự chỉnh chiều cao dòng
- Trả lại chiều rộng cell và merge lại như cũ
------------
Đại khái thế và xem ra giải thuật này cũng y chang code anh đã viết ---> Khỏi test cũng biết là đúng, có điều là: ANH VẪN CHƯA BẪY LỖI
Ẹc... Ẹc...

 

[siwtom]

ANH VẪN CHƯA BẪY LỖI
Ẹc... Ẹc...

Quá chính xác. Cảm ơn nhiều.
"Chưa bẫy lỗi" cũng có thể là "tôi sẽ làm sau" - do code chỉ là code thô, chả có gì đáng nói. Nhưng ở đây là "tôi quên không bẫy lỗi" - đến chỗ này thì cà chua thối, trứng thối bay vù vù về phía siwtom ...