Xin nhờ giúp code bo viềng nội dung

Liên hệ QC

xuantocdotb

Thành viên chính thức
Tham gia
1/6/16
Bài viết
66
Được thích
23
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.
bv1.png
 

File đính kèm

  • bv1.xlsx
    18.8 KB · Đọc: 10
File bị lỗi tải không được
 
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
Mã:
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
 
Lần chỉnh sửa cuối:
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
PHP:
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:

Bạn thử:
PHP:
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 -\\/.
Mã:
Sub test()
    With Selection
        .Borders.LineStyle = 1
        .Offset(, -1).SpecialCells(xlCellTypeBlanks) _
                .Borders(xlEdgeTop).LineStyle = xlNone
    End With
End Sub
 
Lần chỉnh sửa cuối:
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.
 
Bạn thử đoạn này xem
PHP:
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:


Em chạy nó tẳng ra đâu -\\/.
Mã:
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.
 
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.
Mã:
Sub TaoVien()
    Range("D2:E3").Copy
    With Sheet1.Range("D8").CurrentRegion
    .Borders.ColorIndex = xlNone
    .PasteSpecial Paste:=xlPasteFormats
    .Range("D2").Select
    End With
End Sub
 

File đính kèm

  • bv_TaoVien.xlsm
    19.7 KB · Đọc: 7
Web KT
Back
Top Bottom