Xin nhờ giúp code bo viềng nội dung (2 người xem)

[xuantocdotb]

Xin chào các bạn!
Mình có dữ liệu gồm hai cột D và E
Dữ liệu có hơn 700 dòng, mỗi lần cập nhập dữ liệu kéo để bo thủ công rất mất thời gian.
Xin nhờ các bạn giúp mình code tự động bo viềng nội dung như file gửi theo.

 

[XuanThanh]

File bị lỗi tải không được

 

[CHAOQUAY]

Xin chào các bạn!
Mình có dữ liệu gồm hai cột D và E
Dữ liệu có hơn 700 dòng, mỗi lần cập nhập dữ liệu kéo để bo thủ công rất mất thời gian.
Xin nhờ các bạn giúp mình code tự động bo viềng nội dung như file gửi theo.

record macro + chế biến thêm được đoạn code bên dưới, bạn chạy thử xem sao

Sub Macro2()
Dim k
With Sheet1
    k = .Range("E8").End(xlDown).Row
    .Range("D8", "E" & k).Borders.LineStyle = 1
    .Range("D8", "E" & k).AutoFilter
    .Range("D8", "E" & k).AutoFilter Field:=1, Criteria1:="="
    .Range("D9", "D" & k).Borders(xlEdgeTop).LineStyle = 0
    .Range("D8", "E" & k).AutoFilter
End With
End Sub

 

[phulien1902]

Xin chào các bạn!
Mình có dữ liệu gồm hai cột D và E
Dữ liệu có hơn 700 dòng, mỗi lần cập nhập dữ liệu kéo để bo thủ công rất mất thời gian.
Xin nhờ các bạn giúp mình code tự động bo viềng nội dung như file gửi theo.
View attachment 228768

'-----------------------------

 

[♫ђöล♥ßล†♥†µ♫]

Xin chào các bạn!
Mình có dữ liệu gồm hai cột D và E
Dữ liệu có hơn 700 dòng, mỗi lần cập nhập dữ liệu kéo để bo thủ công rất mất thời gian.
Xin nhờ các bạn giúp mình code tự động bo viềng nội dung như file gửi theo.
View attachment 228768

Bạn thử đoạn này xem

Sub Kevien()
    Dim Er As Long, sRng As Range, eRng As Range, Cll As Range, Dk As Boolean
Application.ScreenUpdating = False
Application.EnableEvents = False
Er = Range("E8").End(xlDown).Row
If Er > 8 Then
    Set sRng = Range("D8:D" & Er)
    sRng.Resize(, 2).Borders.LineStyle = xlContinuous
    For Each Cll In sRng
        If Cll.Value = Empty Then
            If eRng Is Nothing Then
                Set eRng = Cll
            Else
                Set eRng = Union(eRng, Cll): Dk = True
            End If
        End If
    Next
    If Dk Then eRng.Borders(xlEdgeTop).LineStyle = xlNone
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

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

Bạn thử:

Sub test()
    Selection.Borders.LineStyle = 1
    Selection.Offset(, -1).SpecialCells(xlCellTypeConstants, 2).Borders(xlDiagonalDown).LineStyle = xlNone
End Sub

Em chạy nó tẳng ra đâu

Sub test()
    With Selection
        .Borders.LineStyle = 1
        .Offset(, -1).SpecialCells(xlCellTypeBlanks) _
                .Borders(xlEdgeTop).LineStyle = xlNone
    End With
End Sub

 

[huuthang_bd]

Dữ liệu có hơn 700 dòng, mỗi lần cập nhập dữ liệu kéo để bo thủ công rất mất thời gian.

Format 2 dòng đầu sau đó dùng Format Painter để định dạng cho phần còn lại. Chỉ 30s thôi.
Muốn tự động thì dùng Conditional Formatting.

 

[phulien1902]

Bạn thử đoạn này xem

Sub Kevien()
    Dim Er As Long, sRng As Range, eRng As Range, Cll As Range, Dk As Boolean
Application.ScreenUpdating = False
Application.EnableEvents = False
Er = Range("E8").End(xlDown).Row
If Er > 8 Then
    Set sRng = Range("D8:D" & Er)
    sRng.Resize(, 2).Borders.LineStyle = xlContinuous
    For Each Cll In sRng
        If Cll.Value = Empty Then
            If eRng Is Nothing Then
                Set eRng = Cll
            Else
                Set eRng = Union(eRng, Cll): Dk = True
            End If
        End If
    Next
    If Dk Then eRng.Borders(xlEdgeTop).LineStyle = xlNone
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

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

Em chạy nó tẳng ra đâu

Sub test()
    With Selection
        .Borders.LineStyle = 1
        .Offset(, -1).SpecialCells(xlCellTypeBlanks) _
                .Borders(xlEdgeTop).LineStyle = xlNone
    End With
End Sub

À, khi ghi Macro anh làm thế này:
1. Quét chọn vùng dữ liệu gồm 2 cột D, E
2. Ctrl+1, chọn Border toàn bộ, Ok
3. Chọn cột D, chọn Ctrl+G, Special.., Constants, chọn Test, OK
4. Ctrl+1, chọn Border, bỏ dòng kẻ dưới , OK
Xong.

Tuy nhiên thu gọn Border lại, không kiểm tra kỹ lại.
Hôm qua em bảo em đi rồi mà? Ai đã giữ chân em lại vậy? Ha ha.

 

[be_09]

Xin chào các bạn!
Mình có dữ liệu gồm hai cột D và E
Dữ liệu có hơn 700 dòng, mỗi lần cập nhập dữ liệu kéo để bo thủ công rất mất thời gian.
Xin nhờ các bạn giúp mình code tự động bo viềng nội dung như file gửi theo.

Bạn thử code sau:
Điều kiện: Tại D2:E3 tạo cái mẫu trước khi chạy code.

Sub TaoVien()
    Range("D2:E3").Copy
    With Sheet1.Range("D8").CurrentRegion
    .Borders.ColorIndex = xlNone
    .PasteSpecial Paste:=xlPasteFormats
    .Range("D2").Select
    End With
End Sub