Kẻ viền sổ nhật ký chung bằng VBA

Liên hệ QC

ketoan100

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia
13/10/07
Bài viết
90
Được thích
13
Xin nhờ các anh chị biết rành về VBA thì xem và giúp em kẻ viền sổ nhật ký chung như mẫu em đã làm sẵn trong sheet của excel.
Em không biết VBA.
Xin chân thành cảm ơn anh chị rất nhiều !
 

File đính kèm

  • GIUP KE KHUNG NHAT KY CHUNG.xlsm
    379.8 KB · Đọc: 12
Ý tưởng Quá hay luôn bạn ơi...
Mình xin mạn phép chỉnh lại code của bạn một tí cho nó nhẹ và gọn hơn nha....
Mã:
   With Sheet8
        lr1 = .Cells(.Rows.Count, "I").End(xlUp).Row
        For i = 11 To lr1
            If IsDate(.Cells(i, 3)) = True Then
               With .Range("A" & i & ":I" & i)
                   .Borders(xlEdgeTop).LineStyle = xlContinuous
                   .Borders(xlEdgeTop).Weight = xlThin
               End With
            End If
        Next i
        MsgBox ("complete!!!")
    End With
Bạn cho mình hỏi, Nếu trường hợp này mà bỏ luôn những đường viền nét đứt, chỉ còn lại đường viền đậm khi kết thúc 1 nghiệp vụ thì mình sẽ bỏ câu lệnh nào để được như thế vậy bạn? (Có nghĩa là ỡ giữa những dòng không có đường viền, chỉ có đường viền đậm trên và dưới thôi.
Cảm ơn bạn rất nhiều!!!
 
Upvote 0
Bạn cho mình hỏi, Nếu trường hợp này mà bỏ luôn những đường viền nét đứt, chỉ còn lại đường viền đậm khi kết thúc 1 nghiệp vụ thì mình sẽ bỏ câu lệnh nào để được như thế vậy bạn? (Có nghĩa là ỡ giữa những dòng không có đường viền, chỉ có đường viền đậm trên và dưới thôi.
Cảm ơn bạn rất nhiều!!!

Thử code:
Mã:
Sub TaoViengMot()
    Application.ScreenUpdating = False
    Dim CellCuoi, i As Long
    CellCuoi = Cells(Rows.Count, 1).End(xlUp).Row
    Sheet8.Range("A7").CurrentRegion.Offset(6).BorderAround xlContinuous, xlThick
    With Sheet8.Range("A10:A" & CellCuoi).SpecialCells(xlCellTypeConstants, 23)
    For i = 0 To 8
        With .Offset(, i).Borders(xlEdgeTop)
            .LineStyle = xlContinuous: .Weight = xlThick
        End With
    Next i
    End With
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn bạn rất nhiều, để mình chạy thử.
Cảm ơn!
 
Upvote 0
Bạn cho mình hỏi, Nếu trường hợp này mà bỏ luôn những đường viền nét đứt, chỉ còn lại đường viền đậm khi kết thúc 1 nghiệp vụ thì mình sẽ bỏ câu lệnh nào để được như thế vậy bạn? (Có nghĩa là ỡ giữa những dòng không có đường viền, chỉ có đường viền đậm trên và dưới thôi.
Cảm ơn bạn rất nhiều!!!
Ý bạn là sao? gởi file cho minh coi ah
 
Upvote 0
Upvote 0
Bài 22 thêm 1 dòng code là xong.
Không cần thêm ah...
Sửa dòng thành Sheet8.[A11:I11].Resize(j - 1).Borders(xlInsideHorizontal).LineStyle = xlNone và kết hợp code bạn @be09 là xong!
ah, code bạn @be09 thì dư 1 border, chỉnh lại CellCuoi = Cells(Rows.Count, 9).End(xlUp).Row (đổi 1 thành 9) thì không dư nữa!

Phải vậy không bạn @be09 ....
 

File đính kèm

  • GIUP KE KHUNG NHAT KY CHUNG -Ans _be09.xlsm
    376.5 KB · Đọc: 8
Upvote 0
Cảm ơn bạn rất nhiều !!!
Bài đã được tự động gộp:

Không cần thêm ah...
Sửa dòng thành Sheet8.[A11:I11].Resize(j - 1).Borders(xlInsideHorizontal).LineStyle = xlNone và kết hợp code bạn @be09 là xong!
ah, code bạn @be09 thì dư 1 border, chỉnh lại CellCuoi = Cells(Rows.Count, 9).End(xlUp).Row (đổi 1 thành 9) thì không dư nữa!

Phải vậy không bạn @be09 ....
Cảm ơn bạn rất nhiều !!!!!
 
Upvote 0
Không cần thêm ah...
Sửa dòng thành Sheet8.[A11:I11].Resize(j - 1).Borders(xlInsideHorizontal).LineStyle = xlNone và kết hợp code bạn @be09 là xong!
ah, code bạn @be09 thì dư 1 border, chỉnh lại CellCuoi = Cells(Rows.Count, 9).End(xlUp).Row (đổi 1 thành 9) thì không dư nữa!

Phải vậy không bạn @be09 ....
1/ Code duyệt dữ liệu từ dưới lên và 1 là dựa vào cột A bạn sửa 9 là dựa vào cột I, 1 hay 9 nó đều như nhau. Vì cột I từ dưới lên đến Cell I2001 không có dữ liệu nên bạn thay 9 thì không thấy viền trên Cell I2000.
2/ Để xóa viền thì sử dụng dòng code sau:

Sheet8.Range("A7").CurrentRegion.Borders.LineStyle = xlNone
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom