Giúp VBA Tự động nhập số khi có dữ liệu

[chidung2009]

Có một file Excel như hình dưới. Cột A Số thứ tự đã có VBA tự động nhập khi nhập dữ liệu cột D
Hiện em muốn cột C sẽ tự động điền Số TL như sau:
- Khi nhập dữ liệu ở Cột D thì cột C tương ứng sẽ tự động tăng 1 đơn vị. Nếu cột C hàng trên chưa có Số TL thì hàng dưới để trống
Mong các anh chị giúp em với ạ

 

[bebo021999]

A6 : . . . . .

=IF(C6="","",COUNTIFS($D$6:D6,"<>",$C$6:C6,"<>"))

 

[chidung2009]

Hôm bữa mình giải thích để viết VBA hơi khó hiểu. Nay mình giải thích lại như sau:
- Khi nhập dữ liệu tại ô D7 thì kết quả của ô C7 = C6+1
Với điều kiện:
- ô C6 đã có giá trị (số)
- ô C7 chưa có giá trị (số)
* Ngược lại:
- Nếu ô C6 ="" (k có dữ liệu) thì ô C7 không thực hiện câu lệnh, tức C7="" (Vẫn giữ nguyên)
- Nếu ô C7 (đã có dữ liệu) mà ô D7 sửa lại dữ liệu hoặc ko thay đổi thì tại ô C7 vẫn giữ nguyên giá trị như cũ.
- Nếu ô D7 xoá hết dữ liệu về "" thì ô C7 cũng xoá dữ liệu theo, tức C7=""

+ Riêng tại hàng thứ 6: Do ô C5 là tiêu đề nên khi nhập dữ liệu ở D6 thì C6 vẫn giữ nguyên giá trị như cũ.

Bài đã được tự động gộp: 22/12/22

=IF(C6="","",COUNTIFS($D$6:D6,"<>",$C$6:C6,"<>"))

Giúp mình bằng vba vs ạ. Nội dung như ghi ở trên

 

[Quang_Hải]

Hôm bữa mình giải thích để viết VBA hơi khó hiểu. Nay mình giải thích lại như sau:
- Khi nhập dữ liệu tại ô D7 thì kết quả của ô C7 = C6+1
Với điều kiện:
- ô C6 đã có giá trị (số)
- ô C7 chưa có giá trị (số)
* Ngược lại:
- Nếu ô C6 ="" (k có dữ liệu) thì ô C7 không thực hiện câu lệnh, tức C7="" (Vẫn giữ nguyên)
- Nếu ô C7 (đã có dữ liệu) mà ô D7 sửa lại dữ liệu hoặc ko thay đổi thì tại ô C7 vẫn giữ nguyên giá trị như cũ.
- Nếu ô D7 xoá hết dữ liệu về "" thì ô C7 cũng xoá dữ liệu theo, tức C7=""

+ Riêng tại hàng thứ 6: Do ô C5 là tiêu đề nên khi nhập dữ liệu ở D6 thì C6 vẫn giữ nguyên giá trị như cũ.

View attachment 284932

Bài đã được tự động gộp: 22/12/22

Giúp mình bằng vba vs ạ. Nội dung như ghi ở trên

Thử đoạn code này. Bạn diễn giải dễ hiểu ghê. Hy vọng trúng ý 50%

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   If .Column = 4 Then
      If .Row > 5 Then
         .Offset(, -3) = .Offset(-1, -3) + 1
         If .Offset(-1, -1) > 0 Then
            .Offset(, -1) = .Offset(-1, -1) + 1
         End If
      End If
   End If
End With
End Sub

 

[chidung2009]

Thử đoạn code này. Bạn diễn giải dễ hiểu ghê. Hy vọng trúng ý 50%

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   If .Column = 4 Then
      If .Row > 5 Then
         .Offset(, -3) = .Offset(-1, -3) + 1
         If .Offset(-1, -1) > 0 Then
            .Offset(, -1) = .Offset(-1, -1) + 1
         End If
      End If
   End If
End With
End Sub

Hiện mình đang ngoài đường nên chưa thử đc. Cảm ơn bạn rất nhiều

 

[bebo021999]

Dùng thử cái này nhé:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D6:D99999")) Is Nothing Then Exit Sub ' Code chi chay khi cot D thay doi
With Target.Offset(, -1) ' o ben canh tai cot C
    If IsEmpty(Target) Then
        .ClearContents ' neu D = "" thi xoa C
    Else
        Select Case IsNumeric(.Offset(-1, 0)) And Not IsEmpty(.Offset(-1, 0)) ' neu o phia tren tai cot C la so
            Case True
                .Value = .Offset(-1, 0) + 1 ' cong them 1
            Case Else
                .ClearContents
        End Select
    End If
End With
Range("A6:A99999").ClearContents
Range("A6", Target.Offset(, -3)).Value = Evaluate("=ROW(A6:A" & Target.Row & ")-5") ' dien STT tai cot A
End Sub

 

[chidung2009]

Dùng thử cái này nhé:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D6:D99999")) Is Nothing Then Exit Sub ' Code chi chay khi cot D thay doi
With Target.Offset(, -1) ' o ben canh tai cot C
    If IsEmpty(Target) Then
        .ClearContents ' neu D = "" thi xoa C
    Else
        Select Case IsNumeric(.Offset(-1, 0)) And Not IsEmpty(.Offset(-1, 0)) ' neu o phia tren tai cot C la so
            Case True
                .Value = .Offset(-1, 0) + 1 ' cong them 1
            Case Else
                .ClearContents
        End Select
    End If
End With
Range("A6:A99999").ClearContents
Range("A6", Target.Offset(, -3)).Value = Evaluate("=ROW(A6:A" & Target.Row & ")-5") ' dien STT tai cot A
End Sub

Cảm ơn bạn nhiều lắm