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

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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

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

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?
 
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.
 
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...
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
 
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ả)
 
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
 
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.
 
- 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ử
 

File đính kèm

lacbuidoi đã viết:
- 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ử
Nhấp chuột vào đây để mở rộng...
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.
 
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 đó
 
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...
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
1.jpg
 
dangky47h đã viết:
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 ạ!
Nhấp chuột vào đây để mở rộng...
Cái này người ta gọi là học từ trên ngọn học xuống gốc nè :p:p:p
 
dangky47h đã viết:
E mới hi nên mong các Anh chị chỉ bảo và giúp đỡ hi
Bài đã được tự động gộp:


Hi E cám ơn
Nhấp chuột vào đây để mở rộng...

Anh toàn sài cái này! em thử xem có sướng không?
Mã: 
'FIX ROW CO DAN DÒNG
Sub MergeCellFit(ByVal MergeCells As Range)
    Dim Diff As Single
    Dim FirstCell As Range, MergeCellArea As Range
    Dim Col As Long, ColCount As Long, RowCount As Long
    Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double

    If MergeCells.Count = 1 Then
        Set MergeCellArea = MergeCells.MergeArea
    Else
        Set MergeCellArea = MergeCells
    End If

    With MergeCellArea
        ColCount = .Columns.Count
        RowCount = .Rows.Count
        .WrapText = True
        If RowCount = 1 And ColCount = 1 Then
            .EntireRow.AutoFit
            GoTo ExitSub
        End If
        Set FirstCell = .Cells(1, 1)
            FirstCellWidth = FirstCell.ColumnWidth
            Diff = 0.75
        For Col = 1 To ColCount
            MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
        Next
            .MergeCells = False
            FirstCell.ColumnWidth = MergeCellWidth - Diff
            .EntireRow.AutoFit
            FirstCellHeight = FirstCell.RowHeight
            .MergeCells = True
            FirstCell.ColumnWidth = FirstCellWidth
            FirstCellHeight = FirstCellHeight / RowCount * 1.15 'Chiêu` cao dòng khi fix sang 2 dòng
            .RowHeight = FirstCellHeight
    End With
ExitSub:
End Sub

Sub CoDanRowBB()
    MergeCellFit Sheets("BBan").Range("E14") '<< dòng cần fix
End Sub
 
vova2209 đã viết:
Anh toàn sài cái này! em thử xem có sướng không?
Mã: 
'FIX ROW CO DAN DÒNG
Sub MergeCellFit(ByVal MergeCells As Range)
    Dim Diff As Single
    Dim FirstCell As Range, MergeCellArea As Range
    Dim Col As Long, ColCount As Long, RowCount As Long
    Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double

    If MergeCells.Count = 1 Then
        Set MergeCellArea = MergeCells.MergeArea
    Else
        Set MergeCellArea = MergeCells
    End If

    With MergeCellArea
        ColCount = .Columns.Count
        RowCount = .Rows.Count
        .WrapText = True
        If RowCount = 1 And ColCount = 1 Then
            .EntireRow.AutoFit
            GoTo ExitSub
        End If
        Set FirstCell = .Cells(1, 1)
            FirstCellWidth = FirstCell.ColumnWidth
            Diff = 0.75
        For Col = 1 To ColCount
            MergeCellWidth = MergeCellWidth + .Cells(1, Col).ColumnWidth + Diff
        Next
            .MergeCells = False
            FirstCell.ColumnWidth = MergeCellWidth - Diff
            .EntireRow.AutoFit
            FirstCellHeight = FirstCell.RowHeight
            .MergeCells = True
            FirstCell.ColumnWidth = FirstCellWidth
            FirstCellHeight = FirstCellHeight / RowCount * 1.15 'Chiêu` cao dòng khi fix sang 2 dòng
            .RowHeight = FirstCellHeight
    End With
ExitSub:
End Sub

Sub CoDanRowBB()
    MergeCellFit Sheets("BBan").Range("E14") '<< dòng cần fix
End Sub
Nhấp chuột vào đây để mở rộng...
Cám ơn Anh, báo lỗi A ơi
 

File đính kèm

  • 2341.jpg
    2341.jpg
    224 KB · Đọc: 53
dangky47h đã viết:
Cám ơn Anh, báo lỗi A ơi
Nhấp chuột vào đây để mở rộng...
@@!
Sub CoDanRowBB()
MergeCellFit Sheets([BGCOLOR=rgb(226, 80, 65)]"BBan"[/BGCOLOR]).Range([BGCOLOR=rgb(226, 80, 65)]"E14"[/BGCOLOR]) '<< dòng cần fix
End Sub

Sheets([BGCOLOR=rgb(226, 80, 65)]"BBan"[/BGCOLOR]) đổi thành Sheets("DANH MUC HSNT")
Còn Range("E14") là dòng cần tự động dãn, thay đổi dòng nào mà bạn cần
vd:
Sub CoDanRowBB()
MergeCellFit Sheets("DANH MUC HSNT").Range("B10")
MergeCellFit Sheets("DANH MUC HSNT").Range("B12")
MergeCellFit Sheets("DANH MUC HSNT").Range("B14")
End Sub
 
vova2209 đã viết:
@@!
Sub CoDanRowBB()
MergeCellFit Sheets([BGCOLOR=rgb(226, 80, 65)]"BBan"[/BGCOLOR]).Range([BGCOLOR=rgb(226, 80, 65)]"E14"[/BGCOLOR]) '<< dòng cần fix
End Sub

Sheets([BGCOLOR=rgb(226, 80, 65)]"BBan"[/BGCOLOR]) đổi thành Sheets("DANH MUC HSNT")
Còn Range("E14") là dòng cần tự động dãn, thay đổi dòng nào mà bạn cần
vd:
Sub CoDanRowBB()
MergeCellFit Sheets("DANH MUC HSNT").Range("B10")
MergeCellFit Sheets("DANH MUC HSNT").Range("B12")
MergeCellFit Sheets("DANH MUC HSNT").Range("B14")
End Sub
Nhấp chuột vào đây để mở rộng...
Anh ơi em bỏ luôn cái phần đầu thế là hết lỗi ạ
PHP: 
Sub CoDanRowBB()
    MergeCellFit Range("E14") '<< dòng cần fix
End Sub
 
anhtuan1066 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Code này khi thêm nội dung vào thì tự giãn để vừa chiều cao dòng nhưng khi xóa đi hình như chiều cao dòng không bị giảm xuống để căn vừa nội dung (chỉ có tăng lên mà không giảm chiều cao dòng xuống được)
 
code nay thi file chạy được nhưng mỗi lần change thì toàn bộ file dãn ngang như từ khổ giấy đứng chuyển qua nằm rồi bình thường lại
 
Chào cả nhà!
Hiện tại các code trên mình thấy nó đáp ứng được khi thực hiện các thảo tác bằng cách clic chuột. Giờ kết hợp với in tự động thì không thực hiên được. Mong mọi người giúp.
 
tuanpccc2009 đã viết:
Chào cả nhà!
Hiện tại các code trên mình thấy nó đáp ứng được khi thực hiện các thảo tác bằng cách clic chuột. Giờ kết hợp với in tự động thì không thực hiên được. Mong mọi người giúp.
Nhấp chuột vào đây để mở rộng...
Bạn thử phương án, với sub sự kiện event

Private Sub Worksheet_Calculate()

End Sub

sẽ có thể giải quyết được
 
Anh/Chị có thể giúp em xem thử sao sheet TB don gia của em không tự động điều chỉnh chiều cao của hàng được ạ? File của em dùng để in hàng loạt nên data trong ô sẽ thay đổi ngắn dài khác nhau. Có thể viết code để tự động điều chỉnh chiều cao tương ứng với mỗi data không ạ?
 

File đính kèm

Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

N
  • Question Question
Sự kiện keydown & textbox user form (1 người xem)
Trả lời
0
Đọc
17
nguyenduy39
N
T
  • Question Question
Kết quả lọc dữ liệu từ sheet TONG HOP qua từng chi tiết
Trả lời
1
Đọc
35
HUONGHCKT
H
S
Cảm ơn Admin đã duyệt (1 người xem)
Trả lời
0
Đọc
29
samthai8017
S
S
Em muốn copy các dữ liệu ô họ tên đã bị gộp từ B9 đến E9. Em muốn pass sang ô B9 (sheet mới). Thank
Trả lời
4
Đọc
59
samthai8017
S
S
Xin các Pro chia sẻ giúp
Trả lời
4
Đọc
65
samthai8017
S
GPE-Trợ Lý
TALKSHOW 16 BẬT MÍ THỦ THUẬT GOOGLE SHEET: TỔNG HỢP DỮ LIỆU TỪ NHIỀU SHEET & FILE BĂNG IMPORTRANGE
Trả lời
1
Đọc
486
GPE-Trợ Lý
GPE-Trợ Lý
B
Em nhờ các bro giúp giải pháp in nhiều file ạ
Trả lời
3
Đọc
62
Hoàng Tuấn 868
H
T
  • Question Question
Code VBA tra cứu kết quả trả về mảng dữ liệu (1 người xem)
    • Cười
Trả lời
17
Đọc
327
LOGANWover
L
HeSanbi
  • Question Question
VBScript.RegExp sẽ bị xóa khỏi Windows: thư viện Pcre2 giải pháp thay thế tối ưu
    • Thích
    • Cảm ơn
Trả lời
1
Đọc
80
HeSanbi
HeSanbi
S
Xin hỏi các pro. Em muốn copy các dữ liệu ô họ tên đã bị gộp từ B9 đến E9. Em muốn pass sang ô B9 (sheet mới).
Trả lời
3
Đọc
61
samthai8017
S
T
Nhờ anh chị tìm giúp nguyên nhân không nhảy dữ liệu Pivotable (1 người xem)
Trả lời
2
Đọc
73
thuhacoicoi
T
HeSanbi
  • Question Question
Chuyển mã VBA ứng dụng Excel 32 bit hoạt động trên cả 64bit (Hoàn toàn 0 phí)
    • Thích
Trả lời
0
Đọc
62
HeSanbi
HeSanbi
T
Ctrl + Shift + 0 không dùng để unhide cột được
Trả lời
24
Đọc
22K
Oji
O
quangminhici
Tặng Addin Word xuất Mail Merge có chức năng cắt ra nhiều file và gửi mail.
    • Thích
    • Yêu thích
Trả lời
19
Đọc
4K
Hoàng Tuấn 868
H
Gà Công Nghệ
Nhờ anh chị chuyển hộ font chữ excel
Trả lời
3
Đọc
99
HeSanbi
HeSanbi
huytamlinh
Anh Chị giúp em sửa lỗi định dạng với ạ !
Trả lời
3
Đọc
50
Hoàng Tuấn 868
H
T
  • Question Question
Xin giúp em mã lệnh tổng hợp tự động lên bảng tổng hợp!
Trả lời
1
Đọc
61
Hoàng Tuấn 868
H
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính
    • Thích
Trả lời
4
Đọc
926
nguyendang95
N
V
Quản lý xuất nhập vật tư trong kho
Trả lời
19
Đọc
768
LOGANWover
L
phuongnam366377
Học C++ từ số 0 – Bài học đầu tiên
    • Cảm ơn
Trả lời
4
Đọc
357
phuongnam366377
phuongnam366377
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom