Tự động tinh chỉnh chiều cao dòng so với text trong ô đó!

Liên hệ QC
Tôi cũng đã xem lại. Code chạy lần 1 thì ok. Chạy lần sau thì không thực hiện được như mong muốn.
Lý do là sau khi set Autofit thì sau bất kỳ sự thay đổi nào, Excel cũng Autofit lại như cũ. Thực tế code có chạy, chiều cao có tăng, nhưng anh Bill lôi lại như cũ.

Cảm ơn sư phụ Phạm Thành Mỹ. Sư phụ rất hiểu vòng lặp For .... Next mong sư phụ tối ưu vòng lặp For .... Next với. Code này chạy được nhưng chậm quá
Nếu anh Bill lôi lại như cũ thì có thể Autofit qua một Sheet trung gian. em thấy không bị lôi lại. Code này chỉnh được chiều cao dòng nhưng với số dòng lớn thì chạy quá chậm. Mong sư phụ cùng mọi người chỉnh giúp code bên trong để chạy nhanh hơn.
Sub RoswHeight()
Application.ScreenUpdating = False
Dim i As Long
Sheets("Chinh04").Select
Range("A16:A345").Select
With Selection
.WrapText = True
End With
Selection.Rows.AutoFit
For i = 16 To 345

Sheet2.Rows(i).RowHeight = Sheet5.Rows(i).RowHeight + 2
Next
Sheets("In 04 A").Select
Range("B18").Select
Application.ScreenUpdating = True
End Sub

File Đính kèm:
http://www.mediafire.com/?844zjx363ca3ss9
 
Lần chỉnh sửa cuối:
Mình xin điều chỉnh chút code các bác xem có ổn không nhe, mình đac test thử chạy khá ổn

Sub RowHeight()
Dim i, n, RH As Long
Application.ScreenUpdating = False
n = Selection.Rows.Count
RH = Application.InputBox("Row hight to add! Input here!", "ROW HIGHT ADD", , , , , , 1)
With Selection
.WrapText = True
.Rows.AutoFit
End With
For i = 1 To n
Selection.Rows(i).RowHeight = Selection.Rows(i).RowHeight + RH
Next
Application.ScreenUpdating = True
End Sub
 
Mình xin điều chỉnh chút code các bác xem có ổn không nhe, mình đac test thử chạy khá ổn

Sub RowHeight()
Dim i, n, RH As Long
Application.ScreenUpdating = False
n = Selection.Rows.Count
RH = Application.InputBox("Row hight to add! Input here!", "ROW HIGHT ADD", , , , , , 1)
With Selection
.WrapText = True
.Rows.AutoFit
End With
For i = 1 To n
Selection.Rows(i).RowHeight = Selection.Rows(i).RowHeight + RH
Next
Application.ScreenUpdating = True
End Sub

Code của bạn theo mình thì đã ổn so với mong muốn của mình
Nhìn Code thấy bạn nghiên cứu VBA rất có bài bản
 
Mình vừa gặp vđ như của bạn, sau khi đọc xong thấy bế tắc quá. Nhưng tìm qua tiếng Arab nó có cái mẹo này rất hay mà mình thấy rất Ok nhé, Do khi chế độ autofit là căn chỉnh theo kích thước của font chữ to nhất trong hàng, nên mình dựa vào cách này thấy hợp lý:
- Ấn Autofit lần 1: Bôi đen các dòng và nhấp đúp
- Insert 1 cột phía ngoài trang in
- Copy 1 cột nào đó ở bên cột trang in, Rồi cho cỡ chữ lớn lên
- Chọn các dòng cần và nhấp đúp phát nữa
- :-)
Chúc bạn thành công!
 
Web KT

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

Back
Top Bottom