Tự dãn cột trong Excel (giúp đỡ)

[tam888]

mình có dọc trên một trang web (mình không nhớ trang web đó) có bày cách làm tự dãn dòng trong excell khi nhập ký tự.
mình muốn định dạng 1 hàng. và nó tự giãn độ rộng của cột (Merge) đuợc không. ai biết giúp mình với

 

[chuot0106]

mình có dọc trên một trang web (mình không nhớ trang web đó) có bày cách làm tự dãn dòng trong excell khi nhập ký tự.
mình muốn định dạng 1 hàng. và nó tự giãn độ rộng của cột (Merge) đuợc không. ai biết giúp mình với

Bạn làm như sau: Chọn ô(cần dãn dòng)--> Fomat->Cells-->Alingment-->tích vào Wrap text-->Ok

 

[tam888]

không. ý mình không phải như vậy.
mình thấy bên trang web khác chỉ cách này.
http://www.upsieutoc.com/images/2014/06/19/untitled3289c.png
và đoạn VBA
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.ScreenUpdating = False
For Each Value In Target.Columns
Worksheets(Sh.Name).Columns(Value.Column).AutoFit
Next Value
Application.ScreenUpdating = True
End Sub

cách trên chỉ làm dãn được 1 hàng theo dòng mà thôi.
đây là hình ảnh file lúc chưa bỏ đoạn VBA này vào http://www.upsieutoc.com/images/2014/06/19/untitled174bc0.png

và đây là hình ảnh khi bỏ vào
http://www.upsieutoc.com/images/2014/06/19/untitled298fc8.png

nhưng mình lại muốn lại được như vậy. vẫn giữ nguyên độ rộng của cột( theo mình điều chỉnh) nhưng lại tăng (điều chỉnh độ dãn của 1 ô liên kết)
http://www.upsieutoc.com/images/2014/06/19/untitled34cc48.png
tại vì file này mình phải chèn rất là nhìu công việc và ký tự ngắn có, dài có
cho nên mình muốn tiện lợi hơn khi không phải canh chỉnh từng biên bản như vậy. bạn nào có thể giúp mình cải thiện được không. thanks mọi người đã quan tâm

 

[chuot0106]

không. ý mình không phải như vậy.
mình thấy bên trang web khác chỉ cách này.
http://www.upsieutoc.com/images/2014/06/19/untitled3289c.png
và đoạn VBA
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.ScreenUpdating = False
For Each Value In Target.Columns
Worksheets(Sh.Name).Columns(Value.Column).AutoFit
Next Value
Application.ScreenUpdating = True
End Sub

cách trên chỉ làm dãn được 1 hàng theo dòng mà thôi.
đây là hình ảnh file lúc chưa bỏ đoạn VBA này vào http://www.upsieutoc.com/images/2014/06/19/untitled174bc0.png

và đây là hình ảnh khi bỏ vào
http://www.upsieutoc.com/images/2014/06/19/untitled298fc8.png

nhưng mình lại muốn lại được như vậy. vẫn giữ nguyên độ rộng của cột( theo mình điều chỉnh) nhưng lại tăng (điều chỉnh độ dãn của 1 ô liên kết)
http://www.upsieutoc.com/images/2014/06/19/untitled34cc48.png
tại vì file này mình phải chèn rất là nhìu công việc và ký tự ngắn có, dài có
cho nên mình muốn tiện lợi hơn khi không phải canh chỉnh từng biên bản như vậy. bạn nào có thể giúp mình cải thiện được không. thanks mọi người đã quan tâm

Tức bạn muốn dùng vba? Nếu vậy tôi sẽ giúp.

 

[tam888]

Ok bạn. giúp mình với. Thanks bạn trc

 

[tam888]

mình có tìm thấy 1 bài viết trên diễn đàn.
http://www.giaiphapexcel.com/forum/showthread.php?6773-Tự-động-
và đoạn mã là
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
khi mình bỏ vào file excel của mình thì nó hiện lỗi này.
http://www.upsieutoc.com/images/2014/06/19/loithemVBA.png
nhờ mấy anh chị nào biết giúp cải thiện.

 

[tam888]

up cho ngày mới. móng mọi người giúp đỡ

 

[phucbugis]

mình có tìm thấy 1 bài viết trên diễn đàn.
http://www.giaiphapexcel.com/forum/showthread.php?6773-Tự-động-
và đoạn mã là
.........
khi mình bỏ vào file excel của mình thì nó hiện lỗi này.
http://www.upsieutoc.com/images/2014/06/19/loithemVBA.png
nhờ mấy anh chị nào biết giúp cải thiện.

có thể do sự kiện tên Private Sub Worksheet_Change bị lặp lại 2 lần trong code module của sheet đó ...



nếu bạn dùng code đó ---> chưa thể Undo được mỗi khi sự kiện đó được kích hoạt.

 

[tam888]

có thể do sự kiện tên Private Sub Worksheet_Change bị lặp lại 2 lần trong code module của sheet đó ...

View attachment 123736

nếu bạn dùng code đó ---> chưa thể Undo được mỗi khi sự kiện đó được kích hoạt.

Nhờ anh có thể giúp em khắc phục được không ạ. em thì không biết gì về VBA hết. chỉ là em có 1 file lập biên bản. trong đó code rất nhìu. và thiếu code làm cho 1 ô liên kết thay đổi theo nội dung cần đưa vào. Anh có thể giúp em được không ạ.

 

[phucbugis]

Nhờ anh có thể giúp em khắc phục được không ạ. em thì không biết gì về VBA hết. chỉ là em có 1 file lập biên bản. trong đó code rất nhìu. và thiếu code làm cho 1 ô liên kết thay đổi theo nội dung cần đưa vào. Anh có thể giúp em được không ạ.

từ Topic đầu tiên đến giờ có thấy bạn gửi file đính kèm theo đâu nhỉ ??? ---> toàn là ...png (mình thì ko chuyên xử lý cái "Photóshop" này lam' )

 

[tam888]

phiền anh vào đây dow về dùm em.
http://4share.vn/f/2d1e191b141f191c/BBNT sang sua.xls
nhờ anh làm giúp em cho tất cả các sheet trong file này. thanks anh nhìu

 

[tam888]

em không biết up file ở đâu hết. phiền anh vào đây dow về giúp em
http://4share.vn/f/2d1e191b141f191c/BBNT sang sua.xls
Nhờ anh làm cho tất cả các she et có trong file BBNT này dùm em. thanks anh

 

[phucbugis]

em không biết up file ở đâu hết. phiền anh vào đây dow về giúp em
http://4share.vn/f/2d1e191b141f191c/BBNT sang sua.xls
Nhờ anh làm cho tất cả các she et có trong file BBNT này dùm em. thanks anh

1 số nội dung các ô cần Auto Fit của bạn đang có công thức kèm theo ---> ko thể dùng sự kiện WS_change

'---> mình tạm thời làm theo cách dùng tổ hợp phím để kích hoạt Macro:
ví dụ:
tại sheet NT Noi Bo bạn chọn ô B25 hoặc B27 --> click Ctrl + Shift + A khi đó sub GPE_AutoFit sẽ tự động kích hoạt ngay tại vị trí ô đang chọn (ActiveCell)

'-----
tham khảo thêm: Macro shortcut trong Excel

 

[tam888]

anh có cách nào làm cho ô B30. sheet NT nội bộ và ô B35 sheet nghiệm thu A-B tự động thây đổi. khi mình bấm vào các biên bản đó được không. tại she et đó. cần phải nhập theo nội dung, các tiêu chuẩn thây đổi theo từng công việc. (cái này nếu sửa bằng thủ công thì cả ngày cũng không xong được)

 

[tam888]

còn em bấm vào ô B25, B27 rồi bấm tổ hợp Ctrl shif A không thấy gì thây đổi cả. chủ yếu là ô có chứa nội nôi tiêu chuẩn áp dụng thôi anh.

 

[tam888]

trong file BBNT này. các shet màu xanh sẽ lấy thông tin bên các shet màu đỏ. đặt biệt là ô có chứa nội dung các tiêu chuẩn áp dụng. nội dung lấy sẽ tuỳ thuộc vào tên công việc nghiệm thu. khi đó khi mình bấm chọn phím tắt bên các shet màu xanh. só biên bản cầm in (cần xem trước khi in) . nó sẽ tự động thay đổi theo nội dung tiêu chuẩn áp dụng kèm theo cho phù hợp là được.

VD: trong shet NT nội bộ. ô B30. khi mình bấm nút tắt để xem từng biên bản nghiệm thu. thì ô B30 sẽ thay đổi nội dung (ô liên kết) (tiêu chuẩn áp dụng cho từng công việc nghiệm thu). làm sao để ô B30 này tự động chuyển đổi cho phù hợp với nội dung là được. (Chủ yếu là ô chứa nội dung tiêu chuẩn này thôi). tương tự những shet khác cũng vậy. nội dung tiêu chuẩn áp dụng cho từng loại biên bản cũng sẽ thay đổi. mong mọi người giúp với.

 

[tam888]

vừa rồi em có thử làm sửa cái code này (chữ in đậm) em bỏ vào mục ThisWorkbook . thì làm được nhưng khi in (xem trước khi in) rất chậm, khoảng 1/2 phút hoặc hơn đó 1 biên bản. rất chậm. nhưng khi in được vào biên bản nó lại báo lỗi. nhờ anh chị sữa đỡ cho em chỗ này cũng được. (code này không tự thu hẹp ô lại được. nhưng cũng đỡ hơn trc) nhưng tốc độ xử lý khi xem, hoặc in rất chậm.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Call AutoFitMergedCellRowHeight(Target)
End Sub


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

 

[phucbugis]

anh có cách nào làm cho ô B30. sheet NT nội bộ và ô B35 sheet nghiệm thu A-B tự động thây đổi. khi mình bấm vào các biên bản đó được không. tại she et đó. cần phải nhập theo nội dung, các tiêu chuẩn thây đổi theo từng công việc. (cái này nếu sửa bằng thủ công thì cả ngày cũng không xong được)

bạn chèn thử đoạn code bên dưới vào sheet NT Noi Bo
(nằm bên trên đoạn If Target.Address <> "$S$1")

If Target.Address = "$B$30" Then
If Target <> "" Then
    Target.EntireRow.AutoFit
    Call AutoFitMergedCellRowHeight(Target)
End If
End If

ô B35 sheet nghiệm thu A-B ---> bạn làm tương tự, đặt đoạn đó vào sheet cần kích hoạt thay đổi địa chỉ $B$30 --> $B$35

'-----
@ #19:
bị lỗi như vậy là do: tên Sub đó chưa có (bạn chưa copy code đó vào File)

 

[tam888]

em bỏ vào rồi. mà nó báo lỗi như vậy.

file anh có bị như vậy không. anh xem giúp em.Thanks anh

 

[tam888]

anh có thể gửi cho em file của anh đã làm được không. chứ em làm theo anh nói. đã bỏ vào sheet NT nội bộ (Như hình trên)( vùng có màu đỏ). nó báo lỗi như vậy.
phiền anh gửi giúp em