Tự động điền công thức vạo cột phụ khi có dữ liệu

[chidung2009]

Mình có 1 sheet chứa dữ liệu từ B6- P6, dữ liệu này càng ngày càng lớn lên có thể lên tới 10.000 nên sẽ làm file excel chạy chậm. Nhưng thực tế lúc đầu dữ liệu không nhiều nhưng mình phải điền công thức lên tới 10.000 để sau này còn sử dụng tới.
Tại cột phụ ô A6 có công thức =IF(OR(AND(C6>=$W$2;C6<=$W$3);AND(H6="";C6>0);AND(H6>$W$3;C6<$W$2);AND(H6>$W$2;H6<$W$3));MAX($A$5:A5)+1;"")
Mình muốn sử dụng VBA để tự động điền công thức (như cột A6) vào các ô tiếp theo và điền số thứ tự vào cột B tương ứng nếu cột D có dữ liệu.

Mong được sự giúp đỡ của anh chị GPE
Mình chân thành cảm ơn!

 

[haonlh]

Gưỉ file lên đi.

Có thể phải dùng sự kiện. Mỗi khi có sự thay đổi ở thì sự kiện hàng nào đó thì kiểm tra các điều kiện như bạn nêu . Đúng thì điền số vô.

 

[chidung2009]

Gưỉ file lên đi.

Có thể phải dùng sự kiện. Mỗi khi có sự thay đổi ở thì sự kiện hàng nào đó thì kiểm tra các điều kiện như bạn nêu . Đúng thì điền số vô.

Mình chỉ mô phỏng dữ liệu như file mình tải lên, vì file chính phức tạp
Anh chị giúp viết Code VBA ở cột phụ (A) và cột thứ tự (B) tự động điền khi cột D có dữ liệu nhập vào
Mình cảm ơn bạn trước

 

[giaiphap]

Mình chỉ mô phỏng dữ liệu như file mình tải lên, vì file chính phức tạp
Anh chị giúp viết Code VBA ở cột phụ (A) và cột thứ tự (B) tự động điền khi cột D có dữ liệu nhập vào
Mình cảm ơn bạn trước

Bạn dùng thử code này xem sao.

Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Cells.Count = 1) And (Target.Row > 5) Then
    If (Target.Column = 4) Then
        Target.Offset(, -2).FormulaR1C1 = "=IF(RC[2]="""","""",MAX(R5C2:R[-1]C)+1)"
    ElseIf (Target.Column = 8) Then
         Target.Offset(, -7).FormulaR1C1 = _
            "=IF(OR(AND(RC[2]>=R2C23,RC[2]<=R3C23),AND(RC[7]="""",RC[2]>0),AND(RC[7]>R3C23,RC[2]<R2C23),AND(RC[7]>R2C23,RC[7]<R3C23)),MAX(R5C1:R[-1]C)+1,"""")"
    End If
End If
End Sub

 

[chidung2009]

Mấy hôm nay truy cập vào GPE khó quá, mãi hôm nay mình mới có thể vào được
Minh cảm ơn code VBA của bạn, sau khi xem mình chỉnh chỉnh sửa thành

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 And Target.Row > 6 Then
    If Target.Count = 1 Then
        Target.Offset(, -2) = "=IF(RC[2]="""","""",MAX(R5C2:R[-1]C)+1)"
        Target.Offset(, -2).Resize(, 2).Value = Target.Offset(, -2).Resize(, 2).Value
        Target.Offset(, -3) = "=IF(OR(AND(RC[2]>=R2C18,RC[2]<=R3C18),AND(RC[7]="""",RC[2]>0),AND(RC[7]>R3C18,RC[2]<R2C18),AND(RC[7]>R2C18,RC[7]<R3C18)),MAX(R5C1:R[-1]C)+1,"""")"
    End If
End If
End Sub

Hiện tại mình muốn sửa một tý nữa là. Khi ô ở cột D xoá dữ liệu thì Công thức cột A cũng xoá theo

 

[langtuchungtinh360]

Mấy hôm nay truy cập vào GPE khó quá, mãi hôm nay mình mới có thể vào được
Minh cảm ơn code VBA của bạn, sau khi xem mình chỉnh chỉnh sửa thành
Hiện tại mình muốn sửa một tý nữa là. Khi ô ở cột D xoá dữ liệu thì Công thức cột A cũng xoá theo

chưa chạy thử, chưa tải file nên không biết đúng ko nha bạn, thử xem thế nào

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 And Target.Row > 6 Then
    If Target.Count = 1 Then
        Target.Offset(, -2) = "=IF(RC[2]="""","""",MAX(R5C2:R[-1]C)+1)"
        Target.Offset(, -2).Resize(, 2).Value = Target.Offset(, -2).Resize(, 2).Value
        Target.Offset(, -3) = "=IF(OR(AND(RC[2]>=R2C18,RC[2]<=R3C18),AND(RC[7]="""",RC[2]>0),AND(RC[7]>R3C18,RC[2]<R2C18),AND(RC[7]>R2C18,RC[7]<R3C18)),MAX(R5C1:R[-1]C)+1,"""")"
[COLOR=#ff0000]    ElseIf len(Target.value)=0 then' nếu dữ liệu tại cột 4 không có
        Target.Offset(, -3).value = ""' xóa dữ liệu cột 1 đi[/COLOR]
    End If
End If
End Sub

 

[chidung2009]

Cảm ơn bạn nhiều, mình đã làm được rồi