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

ketoan100 · 5/6/20

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 !

thnghiachau · 5/6/20

ketoan100 đã viết:
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 !

ý bạn là kẻ từ hàng 11 tới cuối dữ liệu (động) - cuối dữ liệu là hàng mà nơi đó cộ A không có và cột H;I có giá trị phải không????

VetMini · 5/6/20

thnghiachau đã viết:
ý bạn là kẻ từ hàng 11 tới cuối dữ liệu (động) - cuối dữ liệu là hàng mà nơi đó cộ A không có và cột H;I có giá trị phải không????

Căn cứ theo sheet bảng mẫu thì:
Bảng có đường kẻ dọc là đường liền.
Dòng cuối cùng (kết) thì kẻ liền cả trên lẫn dưới nó.
Các dòng khác:
- Dòng có một trong 3 dữ liệu tại A,B,C là dòng phát sinh, kẻ liền trên nó.
- Dòng không có là dòng chi tiết tài khoản, kẻ đứt trên nó.

ketoan100 · 5/6/20

Kẻ từ hàng 11 trở xuống đến hết. khi nghiệp vụ phát sinh bao nhiêu dòng thì nó kẻ bấy nhiêu vòng, kết thúc 1 nghiệp vụ là nó sẽ kẻ 1 đường viền đậm như MẪU NHẬT KÝ CHUNG trong sheet kế bên ấy.
Ở đó mình hạng chế cho nó chưa đến 2000 dòng.
Cảm ơn bạn đã xem qua!

Bài đã được tự động gộp: 5/6/20

Thêm đường viền đậm kết thúc 1 nghiệp vụ là ok. Chỉ yêu cầu như thế thôi. cảm ơn bạn rất nhiều !

Excel my love_1 · 5/6/20

Mình tạm nghĩ nháp: Tìm dòng đầu, tìm dòng cuối, cho kẻ nét đứt từ dòng đầu +3 đến dòng cuối -1, rồi sau đó chạy vòng lặp dựa vào ô cột A có chứa dữ liệu ngày để kẻ nét liền.

PacificPR · 5/6/20

ketoan100 đã viết:
Kẻ từ hàng 11 trở xuống đến hết. khi nghiệp vụ phát sinh bao nhiêu dòng thì nó kẻ bấy nhiêu vòng, kết thúc 1 nghiệp vụ là nó sẽ kẻ 1 đường viền đậm như MẪU NHẬT KÝ CHUNG trong sheet kế bên ấy.
Ở đó mình hạng chế cho nó chưa đến 2000 dòng.
Cảm ơn bạn đã xem qua!

Bài đã được tự động gộp: 5/6/20

Thêm đường viền đậm kết thúc 1 nghiệp vụ là ok. Chỉ yêu cầu như thế thôi. cảm ơn bạn rất nhiều !

Bạn tham khảo thử: Click chuật phải chọn vào cái ô màu đỏ

ketoan100 · 5/6/20

PacificPR đã viết:
Bạn tham khảo thử: Click chuật phải chọn vào cái ô màu đỏ

View attachment 238762
OK. cảm ơn bạn, cách như bạn cũng hay đó nhưng nó hơi bất tiện 1 chút.
Chân thành cảm ơn bạn rất nhiều!

PacificPR · 5/6/20

Đã bất tiện mà sao hay được

Excel my love_1 · 5/6/20

Bạn xem thử
Mình cho Macro vào Nút Xem Sổ của bạn luôn rồi đó

VetMini · 5/6/20

PacificPR đã viết:
Đã bất tiện mà sao hay được

Chỉ tại bất tiện nó sinh biến tật.

Rằng hay thì thật là hay
Nghe ra ngậm đắng nuốt cay thế nào
(Kiều)

thnghiachau · 5/6/20

ketoan100 đã viết:
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 !

Coi thử file nha bạn

thnghiachau · 5/6/20

Excel my love_1 đã viết:
Bạn xem thử
Mình cho Macro vào Nút Xem Sổ của bạn luôn rồi đó

Ý 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

PacificPR · 5/6/20

Mình Record Macro mới được cái này nữa. Bạn Chủ Topic tham khảo thử xem nó có bất tiện nữa không nhoé

PHP:

Sub Macro1()
'
' Macro1 Macro
'
    Dim LastRow As Long, sRng As Range, I As Long
Application.ScreenUpdating = False
LastRow = Range("I" & Rows.Count).End(xlUp).Row
Set sRng = Range("A11:A" & LastRow)
With sRng.Resize(, 9)
    .Borders.LineStyle = 1
    .Borders(xlInsideHorizontal).Weight = xlHairline
End With
With sRng.SpecialCells(xlCellTypeConstants, 23)
    For I = 0 To 8
        With .Offset(, I).Borders(xlEdgeTop)
            .LineStyle = 1
            .Weight = xlThin
        End With
    Next I
End With
Application.ScreenUpdating = True
End Sub

VetMini · 5/6/20

PacificPR đã viết:
Mình Record Macro mới được cái này nữa. Bạn Chủ Topic tham khảo thử xem nó có bất tiện nữa không nhoé

Lần này chắc được tiến bậc. :{{

Excel my love_1 · 5/6/20

thnghiachau đã viết:
Ý 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 chu đáo ghê, Code nhìn gọn hơn hẳn cái nùi Macro nguyên bản của excel

thnghiachau · 5/6/20

PacificPR đã viết:

Mình Record Macro mới được cái này nữa. Bạn Chủ Topic tham khảo thử xem nó có bất tiện nữa không nhoé

PHP:

Sub Macro1()
'
' Macro1 Macro
'
    Dim LastRow As Long, sRng As Range, I As Long
Application.ScreenUpdating = False
LastRow = Range("I" & Rows.Count).End(xlUp).Row
Set sRng = Range("A11:A" & LastRow)
With sRng.Resize(, 9)
    .Borders.LineStyle = 1
    .Borders(xlInsideHorizontal).Weight = xlHairline
End With
With sRng.SpecialCells(xlCellTypeConstants, 23)
    For I = 0 To 8
        With .Offset(, I).Borders(xlEdgeTop)
            .LineStyle = 1
            .Weight = xlThin
        End With
    Next I
End With
Application.ScreenUpdating = True
End Sub

Bác chỉ mình nhấn cái nút record nào mà dc vậy nha... mỗi hàng là 1 lon!!!!

PacificPR · 5/6/20

thnghiachau đã viết:
Bác chỉ mình nhấn cái nút record nào mà dc vậy nha... mỗi hàng là 1 lon!!!!

Bạn này lại chọc quê mình nữa

ketoan100 · 5/6/20

PacificPR đã viết:
Mình Record Macro mới được cái này nữa. Bạn Chủ Topic tham khảo thử xem nó có bất tiện nữa không nhoé
Cảm ơn bạn đã góp ý . Chân thành cảm ơn.

Bài đã được tự động gộp: 5/6/20

Excel my love_1 đã viết:
Bạn xem thử
Mình cho Macro vào Nút Xem Sổ của bạn luôn rồi đó
Xin cảm ơn bạn rất nhiều.

Bài đã được tự động gộp: 5/6/20

PacificPR đã viết:
Đã bất tiện mà sao hay được
Nó hay hơn mình phải tự làm tay, nó tốn rất nhiều thời gian. Lâu lắm bạn ạ. Cảm ơn bạn đã góp ý.

Bài đã được tự động gộp: 5/6/20

thnghiachau đã viết:
Coi thử file nha bạn
Xin cảm ơn bạn đã giúp đỡ.

huuthang_bd · 5/6/20

Vầy đi cho gọn.

Mã:

With Sheet8.Range("A10:A" & Sheet8.Range("I" & Rows.Count).End(xlUp).Row)
    .Resize(, 9).Borders.LineStyle = 1
    .Resize(, 9).Borders(12).Weight = 1
    Intersect(.Resize(, 9), Union(.SpecialCells(2), .Cells(.Rows.Count, 1)).EntireRow).Borders(8).Weight = 2
End With

thnghiachau · 5/6/20

huuthang_bd đã viết:

Vầy đi cho gọn.

Mã:

With Sheet8.Range("A10:A" & Sheet8.Range("I" & Rows.Count).End(xlUp).Row)
    .Resize(, 9).Borders.LineStyle = 1
    .Resize(, 9).Borders(12).Weight = 1
    Intersect(.Resize(, 9), Union(.SpecialCells(2), .Cells(.Rows.Count, 1)).EntireRow).Borders(8).Weight = 2
End With

Rút quá đi thôi

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

Thành viên bị đình chỉ hoạt động

File đính kèm

Supreme Сasual Dating - Real-life Girls

Ăn cùng góc phố

Thành viên bị đình chỉ hoạt động

File đính kèm

Thành viên thường trực

Thành viên mới

File đính kèm

Thành viên bị đình chỉ hoạt động

Thành viên mới

Thành viên thường trực

File đính kèm

Ăn cùng góc phố

Supreme Сasual Dating - Real-life Girls

File đính kèm

Supreme Сasual Dating - Real-life Girls

File đính kèm

Thành viên mới

Ăn cùng góc phố

Thành viên thường trực

Supreme Сasual Dating - Real-life Girls

Thành viên mới

Thành viên bị đình chỉ hoạt động

Chuyên gia GPE

Supreme Сasual Dating - Real-life Girls

Facebook

Group