Giúp code tạo số thứ tự lấp chổ trống và tạo tiếp số thứ tự cho phần cuối

[AnhThu-1976]

Anh chị giúp em tạo số thứ tự như sau
Hiện nay tại sheet Ma cột C em đã có số thứ tự
***********
Bây giờ em sẽ thêm các dòng như sau
ở dòng 19 em chèn thêm một dòng và ghi chữ là bánh n (chữ màu đỏ)
và ở các dòng cuối thì em ghi thêm 3 dòng là bánh 14, 15, 16 (chữ màu xanh)
Như vậy các tên sản phẩm mới ghi thêm chưa có số thứ tự
em muốn code tự động tạo thêm theo nguyên tắc
1/ các mặt hàng đã có số thứ tự thì giữ nguyên
2/ Các mặt hàng nào được chèn vô (giống như mặt hàng bánh n)(dòng màu đỏ) thì lấy số liền kề phía trên)
3/ Còn các mặt hàng mới thêm phía dưới cùng thì tiếp tục tạo số thứ tự tăng dần
Kết quả em mong muốn như sheet Ma(KetquaMongMuon)
Em xin cảm ơn!
p/s: nói ghi chữ màu đỏ hay xanh là để em minh hoạ thêm cho dễ hiểu

 

[HUONGHCKT]

Anh chị giúp em tạo số thứ tự như sau
Hiện nay tại sheet Ma cột C em đã có số thứ tự
***********
Bây giờ em sẽ thêm các dòng như sau
ở dòng 19 em chèn thêm một dòng và ghi chữ là bánh n (chữ màu đỏ)
và ở các dòng cuối thì em ghi thêm 3 dòng là bánh 14, 15, 16 (chữ màu xanh)
Như vậy các tên sản phẩm mới ghi thêm chưa có số thứ tự
em muốn code tự động tạo thêm theo nguyên tắc
1/ các mặt hàng đã có số thứ tự thì giữ nguyên
2/ Các mặt hàng nào được chèn vô (giống như mặt hàng bánh n)(dòng màu đỏ) thì lấy số liền kề phía trên)
3/ Còn các mặt hàng mới thêm phía dưới cùng thì tiếp tục tạo số thứ tự tăng dần
Kết quả em mong muốn như sheet Ma(KetquaMongMuon)
Em xin cảm ơn!
p/s: nói ghi chữ màu đỏ hay xanh là để em minh hoạ thêm cho dễ hiểu

Thủ code này xem sao

Sub SoTT()
Dim i&, k&
For i = 13 To 29
    If Sheet2.Range("C" & i) = Empty Then
        k = Sheet2.Range("C" & i).End(xlDown).Row
        If k < Rows.Count Then Sheet2.Range("C" & i) = Sheet2.Range("C" & i - 1)
        If k = Rows.Count Then Sheet2.Range("C" & i) = Sheet2.Range("C" & i - 1) + 1
    End If
Next i
End Sub

 

[HUONGHCKT]

Cảm ơn các Anh đã quan tâm, xem bài và biểu lộ tình cảm.

 

[VetMini]

Giải thuật:
1. Tìm dòng cuối cột C
2. Copy A:C tới dòng cuối vào mảng a
3. Đọc mảng a, cứ cột 3 trống thì copy ô trên nó.
4. Chép trở lại
5. Tìm dòng cuối cột A
6. Copy A:C từ dòng cuối cột C tới dòng cuối cột A vào mảng a
7. Đọc mảng a từ dòng 2, bổ sung cột 3 bằng cách tăng trị ô trên nó.
8. Chép trở lại

Dùng vòng lặp 1 lần cũng được, chỉ phải mất công phân biệt đã tới giới hạn copy hay tăng (dòng cuối cột B).

Tôi có thắc mắc là bạn làm thế thì về sau này, đọc lại file làm sao biết những chỗ sai?

 

[bebo021999]

Đặt code này trong worksheet module (Right click vào tên sheet, nhấn view code)

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim up, down
On Error Resume Next
If Intersect(Target, Range("A12:A" & Cells(Rows.Count, "A").End(xlUp).Row)) Is Nothing Or IsEmpty(Target) Then Exit Sub
If Not IsEmpty(Target.Offset(0, 2)) Or Target.Count > 1 Then Exit Sub
up = Target.Offset(0, 2).End(xlUp).Value
down = Target.Offset(0, 2).End(xlDown).Value
Target.Offset(0, 2).Value = up + IIf(down = 0 Or down - 1 > up, 1, 0)
End Sub

Mỗ khi có sự thay đổi trong vùng A12 cho đến dòng cuối cột A thì cột STT sẽ tự động cập nhật, không cần chạy code bằng F5 hoặc nút nhấn.