Nhờ giúp đỡ sửa code bo viền

QuangMinhtb · 14/11/19

Xin chào cả nhà GPE!
Tôi có đoạn code dùng để bo viền và đánh số thứ tự tôi tham khảo trên GPE

Mã:

Sub BoVien_Netlien()
Dim DongCuoi As Long
DongCuoi = Range("B" & Rows.Count).End(xlUp).Row
     With ActiveSheet
        .Range("A5").CurrentRegion.Borders.ColorIndex = xlNone
        .Range("A5").CurrentRegion.Borders.LineStyle = xlContinuous
    End With
    If DongCuoi > 1 Then
        With Range("A6:A" & DongCuoi)
          .Cells(1, 1).Value = 1
          .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
        End With
      End If
End Sub

+ Khi chạy code thì được kết quả như hình thứ nhất.
+ Tôi nhờ các bạn chỉnh lại code giúp tôi để khi chạy code có kết quả bo viền như hình thứ hai.
Xin chân thành cảm ơn!

vu_tuan_manh_linh · 14/11/19

Record macro sẽ thấy code, và bạn có thể tự sửa được!

QuangMinhtb · 14/11/19

vu_tuan_manh_linh đã viết:
Record macro sẽ thấy code, và bạn có thể tự sửa được!

Record macro sẽ ra đoạn code rất dài anh ạ!

Mã:

Sub Macro3()
    Selection.AutoFill Destination:=Range("A6:A11"), Type:=xlFillDefault
    Range("A6:A11").Select
    Range("A5:C5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A6:C11").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
End Sub

Làm sao để nó ngắn như đoạn code trên ạ?
Em chua biết về VBA nên anh giúp em mới nhé!

huuthang_bd · 14/11/19

Với code ở bài 1.
Dùng đoạn này

Mã:

     With ActiveSheet.Range("B5").CurrentRegion
        .Borders.ColorIndex = xlNone
        .Borders.LineStyle = xlContinuous
        Range(.Rows(2), .Rows(.Rows.Count)).Borders(12).Weight = xlHairline
    End With

Thay cho đoạn này

Mã:

     With ActiveSheet
        .Range("A5").CurrentRegion.Borders.ColorIndex = xlNone
        .Range("A5").CurrentRegion.Borders.LineStyle = xlContinuous
    End With

QuangMinhtb · 14/11/19

huuthang_bd đã viết:

Với code ở bài 1.
Dùng đoạn này

Mã:

     With ActiveSheet.Range("B5").CurrentRegion
        .Borders.ColorIndex = xlNone
        .Borders.LineStyle = xlContinuous
        Range(.Rows(2), .Rows(.Rows.Count)).Borders(12).Weight = xlHairline
    End With

Thay cho đoạn này

Mã:

     With ActiveSheet
        .Range("A5").CurrentRegion.Borders.ColorIndex = xlNone
        .Range("A5").CurrentRegion.Borders.LineStyle = xlContinuous
    End With

Dạ! cám ơn anh.
Em có chạy code thấy vùng khoanh đỏ vẫn chưa được như ý
Anh xem giúp em ạ!

lehuong1409 · 14/11/19

huuthang_bd đã viết:

Với code ở bài 1.
Dùng đoạn này

Mã:

     With ActiveSheet.Range("B5").CurrentRegion
        .Borders.ColorIndex = xlNone
        .Borders.LineStyle = xlContinuous
        Range(.Rows(2), .Rows(.Rows.Count)).Borders(12).Weight = xlHairline
    End With

Thay cho đoạn này

Mã:

     With ActiveSheet
        .Range("A5").CurrentRegion.Borders.ColorIndex = xlNone
        .Range("A5").CurrentRegion.Borders.LineStyle = xlContinuous
    End With

Em bon chen thêm 1 code lúc trước em cóp nhặt được ạ (Giờ em cũng không nhớ là ở đâu)

Mã:

 With ActiveSheet.Range("B5").CurrentRegion
        .Borders.LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Weight = xlHairline
End With

huuthang_bd · 14/11/19

QuangMinhtb đã viết:
Dạ! cám ơn anh.
Em có chạy code thấy vùng khoanh đỏ vẫn chưa được như ý
Anh xem giúp em ạ!
View attachment 228350

Bạn chuyển đoạn code đấy xuống dưới dòng End If là được.

lehuong1409 đã viết:
Em bon chen thêm 1 code lúc trước em cóp nhặt được ạ (Giờ em cũng không nhớ là ở đâu)

Mã:

With ActiveSheet.Range("B5").CurrentRegion .Borders.LineStyle = xlContinuous .Borders(xlInsideHorizontal).Weight = xlHairline End With

Xem lại xem có giống yêu cầu không nha bạn.

lehuong1409 · 14/11/19

huuthang_bd đã viết:
Xem lại xem có giống yêu cầu không nha bạn.

Dạ vâng. Em thấy rồi ạ. Em cảm ơn anh

QuangMinhtb · 14/11/19

huuthang_bd đã viết:
Bạn chuyển đoạn code đấy xuống dưới dòng End If là được.

Xem lại xem có giống yêu cầu không nha bạn.

Gần được anh ạ! hỳ
+ Nét số 1 là nét liền
+ Nét thứ 2 là nét liền là được anh ạ!
Anh và các bạn xem giúp em.

lehuong1409 · 14/11/19

QuangMinhtb đã viết:
Gần được anh ạ! hỳ
+ Nét số 1 là nét liền
+ Nét thứ 2 là nét liền là được anh ạ!
Anh và các bạn xem giúp em.
View attachment 228354

Mình thấy code này chạy đúng mà. Bạn kiểm tra lại xem

Mã:

Sub BoVien_Netlien()
Dim DongCuoi As Long
DongCuoi = Range("B" & Rows.Count).End(xlUp).Row
    If DongCuoi > 1 Then
        With Range("A6:A" & DongCuoi)
          .Cells(1, 1).Value = 1
          .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
        End With
      End If
With ActiveSheet.Range("B5").CurrentRegion
        .Borders.ColorIndex = xlNone
        .Borders.LineStyle = xlContinuous
        Range(.Rows(2), .Rows(.Rows.Count)).Borders(12).Weight = xlHairline
End With
End Sub

xuantocdotb · 14/11/19

lehuong1409 đã viết:

Mình thấy code này chạy đúng mà. Bạn kiểm tra lại xem

Mã:

Sub BoVien_Netlien()
Dim DongCuoi As Long
DongCuoi = Range("B" & Rows.Count).End(xlUp).Row
    If DongCuoi > 1 Then
        With Range("A6:A" & DongCuoi)
          .Cells(1, 1).Value = 1
          .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
        End With
      End If
With ActiveSheet.Range("B5").CurrentRegion
        .Borders.ColorIndex = xlNone
        .Borders.LineStyle = xlContinuous
        Range(.Rows(2), .Rows(.Rows.Count)).Borders(12).Weight = xlHairline
End With
End Sub

Thành công rồi ạ! em xin cảm ơn.

be_09 · 14/11/19

QuangMinhtb đã viết:
Dạ! cám ơn anh.
Em có chạy code thấy vùng khoanh đỏ vẫn chưa được như ý
Anh xem giúp em ạ!

Bạn tham khảo thêm 1 cách khác, bỏ code vào File mới để thử (code này dùng cho File bạn có thể bị lỗi), lý do (xem hình).

Mã:

Sub DanhTT_TaoVien()
Dim DongCuoi As Long
DongCuoi = Range("B" & Rows.Count).End(xlUp).Row
    With Sheet1
    If DongCuoi > 1 Then
    With Range("A6:A" & DongCuoi)
        .Cells(1, 1).Value = 1
        .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
    End With
    End If
    With .Range("A5").CurrentRegion
        .Borders.ColorIndex = xlNone
        .Borders.LineStyle = xlThin
        .BorderAround xlContinuous
    End With
    .Range("A5").Resize(, 3).Borders.LineStyle = xlContinuous
    End With
End Sub

QuangMinhtb · 14/11/19

be09 đã viết:

Bạn tham khảo thêm 1 cách khác, bỏ code vào File mới để thử (code này dùng cho File bạn có thể bị lỗi).

Mã:

Sub DanhTT_TaoVien()
Dim DongCuoi As Long
DongCuoi = Range("B" & Rows.Count).End(xlUp).Row
    With Sheet1
    If DongCuoi > 1 Then
    With Range("A6:A" & DongCuoi)
        .Cells(1, 1).Value = 1
        .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
    End With
    End If
    With .Range("A5").CurrentRegion
        .Borders.ColorIndex = xlNone
        .Borders.LineStyle = xlThin
        .BorderAround xlContinuous
    End With
    .Range("A5").Resize(, 3).Borders.LineStyle = xlContinuous
    End With
End Sub

Aanh cho em hỏi: (code này dùng cho File bạn có thể bị lỗi) là sao ạ?

be_09 · 14/11/19

QuangMinhtb đã viết:
Aanh cho em hỏi: (code này dùng cho File bạn có thể bị lỗi) là sao ạ?

Mặc định (Name) trong cửa sổ Properties là Sheet1, bạn không nên thay đổi mặc định của Excel.
Xem hình bài 12 sẽ rỏ.

batman1 · 14/11/19

be09 đã viết:
Mặc định (Name) trong cửa sổ Properties là Sheet1, bạn không nên thay đổi mặc định của Excel.
Xem hình bài 12 sẽ rỏ.

Thay đổi cũng được nhưng không nên dùng tên có dấu. Vì thực ra code của bạn khi người ta copy vào tập tin của mình thì bao giờ người ta cũng phải kiểm tra và chỉnh sửa cho dù bạn dùng sheet name hay code name. Sau một thời gian xóa rồi thêm sheet thì có thể không còn Sheet1 hoặc người ta muốn thao tác với sheet khác. Thậm chí cả mình và đối tác (thời đại hợp tác toàn cầu mà) đều không sửa tên mặc định thì vẫn phải kiểm tra và sửa lại code do người khác cung cấp. Khi bạn tạo tập tin mới thì bạn có Sheet1, Sheet2, Sheet3. Nhưng người dùng Excel phiên bản Ba Lan thì người ta có mặc định Arkusz1, Arkusz2, Arkusz3. Đằng nào cũng phải sửa code do người khác cung cấp. Vì thế luôn phải lưu ý người ta là chỗ nào phải sửa cho đúng với tập tin hiện hành.

lehuong1409 · 15/11/19

be09 đã viết:
View attachment 228358

Hôm trước nhờ chú chỉ cháu cách này mà cháu đỡ hẳn vụ muốn lưu tên sheet là tiếng Việt ạ hihi

QuangMinhtb · 15/11/19

be09 đã viết:
Bạn tham khảo thêm 1 cách khác, bỏ code vào File mới để thử (code này dùng cho File bạn có thể bị lỗi), lý do (xem hình).

Mã:

Sub DanhTT_TaoVien() Dim DongCuoi As Long DongCuoi = Range("B" & Rows.Count).End(xlUp).Row With Sheet1 If DongCuoi > 1 Then With Range("A6:A" & DongCuoi) .Cells(1, 1).Value = 1 .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1 End With End If With .Range("A5").CurrentRegion .Borders.ColorIndex = xlNone .Borders.LineStyle = xlThin .BorderAround xlContinuous End With .Range("A5").Resize(, 3).Borders.LineStyle = xlContinuous End With End Sub

View attachment 228358

Em lắp code vào và Run thấy có lỗi, anh xem dùm em.
Cám ơn anh.

be_09 · 15/11/19

QuangMinhtb đã viết:
Em lắp code vào và Run thấy có lỗi, anh xem dùm em.
Cám ơn anh.
View attachment 228397

Xem hình bài 12 để biết và sửa With Sheet1 thành Sheet mà em đang áp dụng code.
Anh sử dụng điện thoại nên chưa xem được.

QuangMinhtb · 15/11/19

be09 đã viết:
Xem hình bài 12 để biết và sửa With Sheet1 thành Sheet mà em đang áp dụng code.
Anh sử dụng điện thoại nên chưa xem được.

Em đã chạy code được và có kết quả, khi nào anh ngồi máy sửa giúp em chút nữa để giống như ý em ở bài 1:
Chỗ nét đứt hiện chuyển về nét đứt ( kiểu như khoanh vùng đỏ)
Cám ơn anh

be_09 · 15/11/19

QuangMinhtb đã viết:
Em đã chạy code được và có kết quả, khi nào anh ngồi máy sửa giúp em chút nữa để giống như ý em ở bài 1:
Chỗ nét đứt hiện chuyển về nét đứt ( kiểu như khoanh vùng đỏ)
Cám ơn anh

Thay dòng code này:
.Borders.LineStyle = xlThin

Bởi dòng code này:
.Borders.Weight = xlHairline

Nhờ giúp đỡ sửa code bo viền

Thành viên hoạt động

File đính kèm

linhvtm84@gmail.com

Thành viên hoạt động

Chuyên gia GPE

Thành viên hoạt động

RILY

Chuyên gia GPE

RILY

Thành viên hoạt động

RILY

Thành viên chính thức

Biên Hòa, Đồng Nai

Thành viên hoạt động

Biên Hòa, Đồng Nai

Thành viên gạo cội

RILY

Thành viên hoạt động

File đính kèm

Biên Hòa, Đồng Nai

Thành viên hoạt động

Biên Hòa, Đồng Nai

Đếm ngược thời gian