[Nhờ giúp đỡ] Tự động điền công thức cho các cột theo điều kiện

[kelacloi]

Em có ví dụ như đính kèm.
Có cách nào tự động điền công thức dựa vào công thức dòng bên trên (copy xuống) khi ta điền dữ liệu vào một cột điều kiện không ạ?

Thanks a chị!

 

[phulien1902]

Em có ví dụ như đính kèm.
Có cách nào tự động điền công thức dựa vào công thức dòng bên trên (copy xuống) khi ta điền dữ liệu vào một cột điều kiện không ạ?

Cảm ơn a chị!

1 cách:

Sub Test()
    Dim i%, LR&
    Application.ScreenUpdating = False
    LR = Cells(Rows.Count, 4).End(xlUp).Row
    For i = 4 To LR
        If Cells(i, 2) = Empty Then
            Cells(i, 5).Resize(, 2).Value = Empty
        ElseIf Cells(i, 2) <> Empty Then
            Cells(3, 5).Resize(, 2).Copy Cells(3, 5).Offset(i - 3).Resize(, 2)
        End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[kelacloi]

1 cách:

Sub Test()
    Dim i%, LR&
    Application.ScreenUpdating = False
    LR = Cells(Rows.Count, 4).End(xlUp).Row
    For i = 4 To LR
        If Cells(i, 2) = Empty Then
            Cells(i, 5).Resize(, 2).Value = Empty
        ElseIf Cells(i, 2) <> Empty Then
            Cells(3, 5).Resize(, 2).Copy Cells(3, 5).Offset(i - 3).Resize(, 2)
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Cảm ơn bạn, nó đã hoạt động nhưng có cách nào không cần assign nó bằng một nút bấm nào mà nó vẫn hoạt động tương tự như sự kiện "change" trong "Worksheet" không bạn nhỉ? Mình đang assign nó bắng nút bấm.
Thanks bạn!

 

[phulien1902]

Cảm ơn bạn, nó đã hoạt động nhưng có cách nào không cần assign nó bằng một nút bấm nào mà nó vẫn hoạt động tương tự như sự kiện "change" trong "Worksheet" không bạn nhỉ? Mình đang assign nó bắng nút bấm.
Cảm ơn bạn!

Bạn thêm vào code sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i%, LR&
    If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
        Call Test
    End If
End Sub

 

[kelacloi]

Bạn thêm vào code sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i%, LR&
    If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
        Call Test
    End If
End Sub

Đã hoạt động như ý.
Cảm ơn ban rất nhiều!