VBA gạch chân chữ

[Chian91]

E có một vấn đề mong cả nhà giúp đỡ. Trong file e đính kèm e muốn gạch chân các chữ trong ô, nếu độ rộng của chữ chưa bằng độ rộng của ô thì cũng gạch chân đến hết độ rộng của ô. Em cám ơn cả nhà.

 

[chiendich]

Dạ, bác hướng dẫn cho em với ạ, em cám ơn bác!

 

[Chian91]

Chưa được như thế nào

Chưa được như thế nào

Khi Cell đó Wrap Text thì không được ạ!

 

[HieuCD]

Khi Cell đó Wrap Text thì không được ạ!

File của mình vẫn được, gởi file không được lên

 

[be_09]

View attachment 224276

Cách của em nó chỉ áp dụng đối với dữ liệu nằm trên 1 dòng thì được, còn trường hợp 1 Cell mà nhiều dòng và có sử dụng Wrap Text thì không được.

Chủ Topic yêu cầu giống như E2: G7 (như hình).

 

[Chian91]

Cách của em nó chỉ áp dụng đối với dữ liệu nằm trên 1 dòng thì được, còn trường hợp 1 Cell mà nhiều dòng và có sử dụng Wrap Text thì không được.

Chủ Topic yêu cầu giống như E2: G7 (như hình).
View attachment 224288

Bác hướng dẫn cho e với ạ. E cám ơn bác!

 

[LamNA]

Bác hướng dẫn cho e với ạ. E cám ơn bác!

Nếu xác định được bao nhiêu chữ một dòng thì tự động xuống dòng thì chắc anh chị diễn đàn hỗ trợ tốt hơn, còn không xác định được thì hiện tại chỉ có 2 kết quả.
aaaaaaaaa
aaaa
hoặc
aaaaaaaa
aaa_____

 

[LamNA]

E có một vấn đề mong cả nhà giúp đỡ. Trong file e đính kèm e muốn gạch chân các chữ trong ô, nếu độ rộng của chữ chưa bằng độ rộng của ô thì cũng gạch chân đến hết độ rộng của ô. Em cám ơn cả nhà.

Xem thử cách này xem được không?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim change As Range
Set change = Intersect(Target, Range("A2:A100")) ' Thay doi vung muon dinh dang
Application.ScreenUpdating = False
If Not change Is Nothing Then
    Target.Font.Underline = True
    Target.WrapText = True
End If
With Target.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
End With
Application.ScreenUpdating = True
End Sub

 

[Chian91]

Xem thử cách này xem được không?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim change As Range
Set change = Intersect(Target, Range("A2:A100")) ' Thay doi vung muon dinh dang
Application.ScreenUpdating = False
If Not change Is Nothing Then
    Target.Font.Underline = True
    Target.WrapText = True
End If
With Target.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
End With
Application.ScreenUpdating = True
End Sub

Em cảm ơn bác đã giúp đỡ, nhưng trong trường hợp Meger cột A:cột E thì không được ạ!

 

[LamNA]

Em cảm ơn bác đã giúp đỡ, nhưng trong trường hợp Meger cột A:cột E thì không được ạ!

Bạn thử lại xem đúng ý chưa nhé
Trong module

Option Explicit
Sub Merge()
    Dim AB As Single
    Dim A As Range
    Dim rng As Range
    Dim B As Double
    Dim Dorong As Double
    Dim ar As Variant
    Dim i As Integer
Application.ScreenUpdating = False
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    On Error Resume Next
    Set rng = Range(Range("A" & i).MergeArea.Address)
    rng.MergeCells = False
    B = rng.Cells(1).ColumnWidth
    AB = 0
    For Each A In rng
        A.WrapText = True
        A.HorizontalAlignment = xlLeft
        A.VerticalAlignment = xlCenter
        A.Font.Underline = True
        A.Borders(xlEdgeBottom).LineStyle = xlContinuous
        AB = A.ColumnWidth + AB
    Next
    AB = AB + rng.Cells.Count * 0.66
    rng.Cells(1).ColumnWidth = AB
    rng.EntireRow.AutoFit
    Dorong = rng.RowHeight
    rng.Cells(1).ColumnWidth = B
    rng.MergeCells = True
    rng.RowHeight = Dorong
Next i
Application.ScreenUpdating = True
End Sub

Trong sheet 1

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)) Is Nothing Then
        Call Merge
    End If
End Sub

 

[befaint]

xem đúng ý chưa

Đến tận bây giờ đã có ai biết ý người ta như nào đâu mà đúng hay không đúng?

Bao nhiêu bài nhử nhử các kiểu, các thể loại mà có thấy chủ thớt nói cái ý của mình hình thù ra làm sao đâu?

 

[LamNA]

Đến tận bây giờ đã có ai biết ý người ta như nào đâu mà đúng hay không đúng?

Bao nhiêu bài nhử nhử các kiểu, các thể loại mà có thấy chủ thớt nói cái ý của mình hình thù ra làm sao đâu?

Thì em đang mò cữ ngỡ bài 27 chắc đúng ý, ai ngờ lồi thêm cái merge đến hiện tại thú thật không biết chủ thớt muốn định dạng như vậy để làm gì nữa

 

[Chian91]

Thì em đang mò cữ ngỡ bài 27 chắc đúng ý, ai ngờ lồi thêm cái merge đến hiện tại thú thật không biết chủ thớt muốn định dạng như vậy để làm gì nữa

Cám ơn bác quan tâm. Yêu cầu của e được viết lại trong file đính kèm ạ. Em cám ơn bác nhiều

Bài đã được tự động gộp: 16/9/19

Đến tận bây giờ đã có ai biết ý người ta như nào đâu mà đúng hay không đúng?

Bao nhiêu bài nhử nhử các kiểu, các thể loại mà có thấy chủ thớt nói cái ý của mình hình thù ra làm sao đâu?

Cám ơn bác quan tâm. yêu cầu của e được viết rõ lại trong file đính kèm ạ.

 

[befaint]

Cám ơn bác quan tâm. yêu cầu của e được viết rõ lại trong file đính kèm ạ.

"2. Dữ liệu chuyển sang Sheet 2 được gạch chân như được viết trên 1 dòng kẻ"

Tới giờ này có thấy cái khúc màu đỏ kia hình thù như nào đâu?

Tiết mục chuột vờn mèo tiếp tục nào..

 

[VetMini]

...
Tiết mục chuột vờn mèo tiếp tục nào..

Diễn đàn này nhiều người mắc bệnh ma-sô-kít (*) lắm. Sẽ còn hỏi đoán dài dài.

(*) tiếng xưa. Bây giờ thì người ta chuộng tiếng Anh hơn, quý vị có thể gú gô từ khóa "masochism".

 

[batman1]

Đoán mò thì thế này:

1. Chuỗi ký tự có thể nhập vào 1 ô hoặc nhiều ô được gộp thành một.
2. Chuỗi có thể tự gõ hoặc lấy từ nơi khác.
3. Chuỗi dài ngắn tùy ý. Do chiều rộng của ô có hạn nên ô sẽ luôn có WrapText = True.
4. Chuỗi có thể xuống dòng (Alt + Enter) ở giữa dòng ở một hoặc nhiều nơi bất kỳ trong chuỗi.

Bây giờ xin các masochist ra tay.

Lưu ý:
1. Do chủ thớt không bao giờ mô tả dữ liệu nên điểm 4 có thể tôi đoán mò sai.
2. Tưng tập tin lên chưa phải là đủ. Thậm chí tung tập tin lên cùng với mô tả yêu cầu chưa phải là tất cả. LUÔN LUÔN mô tả dạng dữ liệu. Một điều hiển nhiên thế mà không hiểu sao, hỡi các vị chủ thớt!