Giúp code gạch ngang dòng theo cột mã hàng (1 người xem)

[minhtuan55]

Chào cả nhà GPE !. Em cần 1 đoạn code để gạch ngang tự động theo cột mã hàng như sau ( Mọi khi là em bôi đen làm thủ công, do dữ liệu thay đổi thường xuyên nên làm rất mất thời gian ). Xin mọi người giúp đở xin chân thành cảm ơn
Mình đang dùng code này mà nó dài quá. Có cách nào Ngắn gọn hơn không mọi người

Sub afaf()

      Range("A3:D100").Borders(xlDiagonalDown).LineStyle = xlNone
      Range("A3:D100").Borders(xlDiagonalUp).LineStyle = xlNone
      Range("A3:D100").Borders(xlEdgeLeft).LineStyle = xlNone
      Range("A3:D100").Borders(xlEdgeTop).LineStyle = xlNone
      Range("A3:D100").Borders(xlEdgeBottom).LineStyle = xlNone
      Range("A3:D100").Borders(xlEdgeRight).LineStyle = xlNone
      Range("A3:D100").Borders(xlInsideVertical).LineStyle = xlNone
      Range("A3:D100").Borders(xlInsideHorizontal).LineStyle = xlNone
      
Dim i As Long

For i = 3 To 100
If Range("a" & i) <> "" Then

    Range("A" & i & ":D" & i).Select
     Range("A" & i & ":D" & i).Borders(xlDiagonalDown).LineStyle = xlNone
    Range("A" & i & ":D" & i).Borders(xlDiagonalUp).LineStyle = xlNone
     Range("A" & i & ":D" & i).Borders(xlEdgeLeft).LineStyle = xlNone
    With Range("A" & i & ":D" & i).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With

End If
Next i

End Sub

 

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

Chào cả nhà GPE !. Em cần 1 đoạn code để gạch ngang tự động theo cột mã hàng như sau ( Mọi khi là em bôi đen làm thủ công, do dữ liệu thay đổi thường xuyên nên làm rất mất thời gian ). Xin mọi người giúp đở xin chân thành cảm ơn
Mình đang dùng code này mà nó dài quá. Có cách nào Ngắn gọn hơn không mọi người

Sub afaf()

      Range("A3:D100").Borders(xlDiagonalDown).LineStyle = xlNone
      Range("A3:D100").Borders(xlDiagonalUp).LineStyle = xlNone
      Range("A3:D100").Borders(xlEdgeLeft).LineStyle = xlNone
      Range("A3:D100").Borders(xlEdgeTop).LineStyle = xlNone
      Range("A3:D100").Borders(xlEdgeBottom).LineStyle = xlNone
      Range("A3:D100").Borders(xlEdgeRight).LineStyle = xlNone
      Range("A3:D100").Borders(xlInsideVertical).LineStyle = xlNone
      Range("A3:D100").Borders(xlInsideHorizontal).LineStyle = xlNone
     
Dim i As Long

For i = 3 To 100
If Range("a" & i) <> "" Then

    Range("A" & i & ":D" & i).Select
     Range("A" & i & ":D" & i).Borders(xlDiagonalDown).LineStyle = xlNone
    Range("A" & i & ":D" & i).Borders(xlDiagonalUp).LineStyle = xlNone
     Range("A" & i & ":D" & i).Borders(xlEdgeLeft).LineStyle = xlNone
    With Range("A" & i & ":D" & i).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With

End If
Next i

End Sub

View attachment 195758

Cái này ngắn hơn được 6 dòng

Sub afaf()
    Dim i As Long, Rng As Range
Range("A3:D100").Borders.LineStyle = xlNone
For i = 3 To 100
    If Range("a" & i) <> "" Then
        If Rng Is Nothing Then
            Set Rng = Range("A" & i & ":" & "D" & i)
        Else
            Set Rng = Union(Rng, Range("A" & i & ":" & "D" & i))
        End If
    End If
Next i
With Rng
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeTop).Weight = xlMedium
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).Weight = xlMedium
End With
End Sub

 

[HieuCD]

Cái này ngắn hơn được 6 dòng

Sub afaf()
    Dim i As Long, Rng As Range
Range("A3:D100").Borders.LineStyle = xlNone
For i = 3 To 100
    If Range("a" & i) <> "" Then
        If Rng Is Nothing Then
            Set Rng = Range("A" & i & ":" & "D" & i)
        Else
            Set Rng = Union(Rng, Range("A" & i & ":" & "D" & i))
        End If
    End If
Next i
With Rng
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeTop).Weight = xlMedium
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).Weight = xlMedium
End With
End Sub

Chuẩn bị hơi dài, ngắn hơn nữa được mà

 

[gttrongvn]

Nếu dữ liệu có nhiều thì mình nghĩ dùng cái này sẽ tốt hơn là dùng vòng lặp.

Sub Macro1()
With Range("A3:D" & Range("A" & Rows.Count).End(xlUp).Row)
      .Borders.LineStyle = xlNone
      .AutoFilter Field:=1, Criteria1:="<>"  
      With  .SpecialCells(xlCellTypeVisible)
            .Borders(xlEdgeTop).Weight = xlMedium
            .Borders(xlInsideHorizontal).Weight = xlMedium
      End With
      .AutoFilter
End With
End Sub