Tự động co dãn bảng khi thêm mới dữ liệu và copy công thức

[JungSangAh]

Chào buổi chiều cả nhà ạ.
Em có một file kèm theo và mong muốn khi em thêm mới dữ liệu thì nó tự động thêm hàng và cột, copy công thức tự động.
Với những hàng, cột cuối cùng chứa dữ liệu nó để trắng
Với những hàng, cột cuối cùng chứa công thức nó tự động copy

Em xin cảm ơn trước sự trợ giúp của các cao nhân trong GPE ạ.

 

[befaint]

Tự động thêm cột thì hơi khó hiểu về cấu trúc dữ liệu.
Thêm dòng, công thức tự động thì đơn giản là dùng Table. Thao tác: chọn vùng dữ liệu, nhấn tổ hợp phím Ctrl + T, rồi nhấn Enter.

 

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

Tự động thêm cột thì hơi khó hiểu về cấu trúc dữ liệu.
Thêm dòng, công thức tự động thì đơn giản là dùng Table. Thao tác: chọn vùng dữ liệu, nhấn tổ hợp phím Ctrl + T, rồi nhấn Enter.

Em ứ chịu Table đâu. Em thích Code cơ

Chào buổi chiều cả nhà ạ.
Em có một file kèm theo và mong muốn khi em thêm mới dữ liệu thì nó tự động thêm hàng và cột, copy công thức tự động.
Với những hàng, cột cuối cùng chứa dữ liệu nó để trắng
Với những hàng, cột cuối cùng chứa công thức nó tự động copy

Em xin cảm ơn trước sự trợ giúp của các cao nhân trong GPE ạ.

Bạn xem thử

 

[phulien1902]

Chào buổi chiều cả nhà ạ.
Em có một file kèm theo và mong muốn khi em thêm mới dữ liệu thì nó tự động thêm hàng và cột, copy công thức tự động.
Với những hàng, cột cuối cùng chứa dữ liệu nó để trắng
Với những hàng, cột cuối cùng chứa công thức nó tự động copy

Em xin cảm ơn trước sự trợ giúp của các cao nhân trong GPE ạ.

+ Code Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)     '  ** Check if Cell J4 is updated
    If Not Intersect(Target, Range("A3:A500")) Is Nothing Then
       Call abc
    End If
End Sub

+ Code Module

Sub abc()
Dim i&, LR&
  LR = Cells(Rows.Count, 1).End(3) + 5
    Application.ScreenUpdating = False
    For i = 3 To LR
        If Cells(i, 1) <> Empty Then
          Range("F3:F" & LR) = "=IF(RC[-1]="""","""",COUNTIF(R3C5:RC5,RC[-1]))"
          Range("A3:F" & LR).CurrentRegion.Borders.LineStyle = 1
        End If
    Next
   Application.ScreenUpdating = True
End Sub

 

[JungSangAh]

+ Code Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)     '  ** Check if Cell J4 is updated
    If Not Intersect(Target, Range("A3:A500")) Is Nothing Then
       Call abc
    End If
End Sub

+ Code Module

Sub abc()
Dim i&, LR&
  LR = Cells(Rows.Count, 1).End(3) + 5
    Application.ScreenUpdating = False
    For i = 3 To LR
        If Cells(i, 1) <> Empty Then
          Range("F3:F" & LR) = "=IF(RC[-1]="""","""",COUNTIF(R3C5:RC5,RC[-1]))"
          Range("A3:F" & LR).CurrentRegion.Borders.LineStyle = 1
        End If
    Next
   Application.ScreenUpdating = True
End Sub

Em xin chân thành cảm ơn sự giúp đỡ của bác.