có dữ liệu thì tự Border (1 người xem)

[NguyenthiH]

chảo mọi người!
Xin mọi người giúp em code khi có dữ liệu vào Cell Sheet1!A2 thì border từ A2.
Em có đoạn code của Anh HieuCD làm giúp

Private Sub Worksheet_Activate()
  Dim Darr(), Arr(), Dic As Object, Tmp As String, i As Long, k As Long, LastN As Long, LastX As Long
  LastN = Sheets("Nhap").Range("B65500").End(xlUp).Row
  LastX = Sheets("Xuat").Range("B65500").End(xlUp).Row
  If LastN > 1 Then
    Darr = Sheets("Nhap").Range("B2:E" & LastN).Value
    ReDim Arr(1 To LastN + LastX - 2, 1 To 6)
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Darr)
      Tmp = Darr(i, 1) & "#" & Darr(i, 2)
      If Not Dic.exists(Tmp) Then
        k = k + 1
        Dic.Add Tmp, k
        Arr(k, 1) = Darr(i, 1)
        Arr(k, 2) = Darr(i, 2)
        Arr(k, 3) = Darr(i, 3)
        Arr(k, 4) = 0:  Arr(k, 5) = 0
      End If
      Arr(Dic.Item(Tmp), 4) = Arr(Dic.Item(Tmp), 4) + Darr(i, 4)
    Next
    If LastX > 1 Then
      Darr = Sheets("Xuat").Range("B2:F" & LastX).Value
      For i = 1 To UBound(Darr)
        Tmp = Darr(i, 1) & "#" & Darr(i, 2)
        If Dic.exists(Tmp) Then
          Arr(Dic.Item(Tmp), 5) = Arr(Dic.Item(Tmp), 5) + Darr(i, 5)
        End If
      Next i
    End If
    For i = 1 To k
      Arr(i, 6) = Arr(i, 4) - Arr(i, 5)
    Next i
    LastN = Range("A65500").End(xlUp).Row
    Application.ScreenUpdating = False
    If LastN > 1 Then
      Range("A2:F" & LastN).ClearContents
[B][COLOR=#ff0000]      Range("A2:F" & LastN).Borders.LineStyle = xlNone[/COLOR][/B]
    End If
    If k > 0 Then
      Range("A2").Resize(k, 6) = Arr
[B][COLOR=#ff0000]      Range("A2").Resize(k, 6).Borders.LineStyle = 1[/COLOR][/B]
      Range("D2").Resize(k, 3).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
      Range("A2").Resize(k, 6).Sort [A2], 1, [B2], , 1, Header:=xlNo
    End If
    Application.ScreenUpdating = True
  End If
  Set Dic = Nothing
End Sub

Em biết chổ chữ đỏ là tạo Border, nhưng không biết viết cho riêng Cell A2
Mong mọi người chỉ giáo.

 

[NguyenthiH]

Em vọc đại như vầy:

Private Sub Worksheet_Change(ByVal Target As Range)
k As Long, LastR As Long
 LastR = Sheets("Nhap").Range("A65500").End(xlUp).Row
 If LastR > 1 Then
    Range("A2:D" & LastN).Borders.LineStyle = xlNone
 If k > 0 Then
    Range("A2").Resize(k, 3).Borders.LineStyle = 1
End If
End If
End Sub

nhưng không được, mong mọi người chỉ giáo.

 

[quanluu]

Em vọc đại như vầy:

Private Sub Worksheet_Change(ByVal Target As Range)
k As Long, LastR As Long
 LastR = Sheets("Nhap").Range("A65500").End(xlUp).Row
 If LastR > 1 Then
    Range("A2:D" & LastN).Borders.LineStyle = xlNone
 If k > 0 Then
    Range("A2").Resize(k, 3).Borders.LineStyle = 1
End If
End If
End Sub

nhưng không được, mong mọi người chỉ giáo.

Thử thế này coi

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LastR As Long
    If Target.Address = "$A$2" And Range("A2") <> "" Then
        LastR = Sheets("Nhap").Range("A65500").End(xlUp).Row
        Range("A2:D" & LastN).Borders.LineStyle = 1
    End If
End Sub

 

[NguyenthiH]

Không dược anh Ơi!
Lỗi Error "13"- Type mismastc
Debud ngay dòng

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LastR As Long
    If Target.Address = "$A$2" And Range("A2") <> "" Then
[B][COLOR=#ff0000]        LastR = Sheets(Sheet1).Range("A65500").End(xlUp).Row[/COLOR][/B]
        Range("A2:D" & LastR).Borders.LineStyle = 1
    End If
End Sub

Mong anh giúp

 

[nghiaphuc]

Không dược anh Ơi!
Lỗi Error "13"- Type mismastc
Debud ngay dòng

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LastR As Long
    If Target.Address = "$A$2" And Range("A2") <> "" Then
[B][COLOR=#ff0000]        LastR = Sheets(Sheet1).Range("A65500").End(xlUp).Row[/COLOR][/B]
        Range("A2:D" & LastR).Borders.LineStyle = 1
    End If
End Sub

Mong anh giúp

Bạn sửa Sheet1 thành "Sheet1" xem.

 

[NguyenthiH]

Sửa như anh Nghia Phuc thì được rồi, nhưng chỉ có A22 là có Border.
ý của em là cứ có tiếp dữ liệu thì có Border, tiếp đến A33 và A44..v...v.v.v.
như vòng lặp for...next vậy
Mong các anh chỉ giáo

 

[quanluu]

Sửa như anh Nghia Phuc thì được rồi, nhưng chỉ có A22 là có Border.
ý của em là cứ có tiếp dữ liệu thì có Border, tiếp đến A33 và A44..v...v.v.v.
như vòng lặp for...next vậy
Mong các anh chỉ giáo

Bạn sửa
If Target.Address = "$A$2" And Range("A2") <> "" Then

thành


If Target.column = 1 Then

 

[NguyenthiH]

cám Ơn Anh quanluu1989 được rồi ah!