Em xin được sự giúp đỡ: tự động chèn thêm dòng và điền mã số ở ô vừa được chèn

[chothadiem]

Em nhờ Các anh chị và Thầy cô giúp em bài toán sau ạ:
1.Khi mà cột E có Nội dung bắt đầu bằng "Cát đắp" ở vị trí đầu dòng thì tự chèn thêm 1 dòng vào ngay bên dưới và đánh mã "LMDC" vào cột C của dòng trống vừa được chèn (như dòng 5 và dòng 6 trong file đính kèm).
2.Khi mà cột E có Nội dung bắt đầu bằng "Bê tông" ở vị trí đầu dòng thì tự chèn thêm 1 dòng vào ngay bên dưới và đánh mã "LMBT" vào cột C của dòng trống vừa được chèn (như dòng 12 và dòng 13 trong file đính kèm).
3.Khi mà cột E có Nội dung bắt đầu bằng "Vữa xây" hoặc "Vữa trát" ở vị trí đầu dòng thì tự chèn thêm 1 dòng vào ngay bên dưới và đánh mã "LMV" vào cột C của dòng trống vừa được chèn (như dòng 15 và dòng 16 trong file đính kèm).
(Pass: Nếu không chèn được tự động thì giúp em cách đánh mã "LMDC",..... vào cột C như em đã nêu, còn chèn dòng em sẽ chèn thủ công ạ! )

Em xin cảm ơn!

 

[vba_gpe]

Em nhờ Các anh chị và Thầy cô giúp em bài toán sau ạ:
1.Khi mà cột E có Nội dung bắt đầu bằng "Cát đắp" ở vị trí đầu dòng thì tự chèn thêm 1 dòng vào ngay bên dưới và đánh mã "LMDC" vào cột C của dòng trống vừa được chèn (như dòng 5 và dòng 6 trong file đính kèm).
2.Khi mà cột E có Nội dung bắt đầu bằng "Bê tông" ở vị trí đầu dòng thì tự chèn thêm 1 dòng vào ngay bên dưới và đánh mã "LMBT" vào cột C của dòng trống vừa được chèn (như dòng 12 và dòng 13 trong file đính kèm).
3.Khi mà cột E có Nội dung bắt đầu bằng "Vữa xây" hoặc "Vữa trát" ở vị trí đầu dòng thì tự chèn thêm 1 dòng vào ngay bên dưới và đánh mã "LMV" vào cột C của dòng trống vừa được chèn (như dòng 15 và dòng 16 trong file đính kèm).
(Pass: Nếu không chèn được tự động thì giúp em cách đánh mã "LMDC",..... vào cột C như em đã nêu, còn chèn dòng em sẽ chèn thủ công ạ! )

Em xin cảm ơn!
View attachment 208811

Bạn thử thêm code này vào thử xem:

Sub Vd()
    Dim shdata As Worksheet
    Dim shInfor As Worksheet
    Set shInfor = Sheets("infor")
    Set shdata = Sheets("Data")
    Dim i As Long
    With shdata
        For i = .Range("E" & .Rows.Count).End(xlUp).Row To 1 Step -1
            If .Range("E" & i) <> "" Then
                Dim j As Long
                For j = 2 To shInfor.Range("A600").End(xlUp).Row
                    If Left(.Range("E" & i).Value, Len(shInfor.Range("A" & j).Value)) = shInfor.Range("A" & j).Value Then
                        shdata.Range("A" & i + 1 & ":A" & i + shInfor.Range("B" & j).Value).EntireRow.Insert
                        shdata.Range("C" & i + 1).Value = shInfor.Range("C" & j).Value
                        Exit For
                    End If
                Next
            End If
        Next
    End With
End Sub

 

[snow25]

Bạn thử thêm code này vào thử xem:

Sub Vd()
    Dim shdata As Worksheet
    Dim shInfor As Worksheet
    Set shInfor = Sheets("infor")
    Set shdata = Sheets("Data")
    Dim i As Long
    With shdata
        For i = .Range("E" & .Rows.Count).End(xlUp).Row To 1 Step -1
            If .Range("E" & i) <> "" Then
                Dim j As Long
                For j = 2 To shInfor.Range("A600").End(xlUp).Row
                    If Left(.Range("E" & i).Value, Len(shInfor.Range("A" & j).Value)) = shInfor.Range("A" & j).Value Then
                        shdata.Range("A" & i + 1 & ":A" & i + shInfor.Range("B" & j).Value).EntireRow.Insert
                        shdata.Range("C" & i + 1).Value = shInfor.Range("C" & j).Value
                        Exit For
                    End If
                Next
            End If
        Next
    End With
End Sub

Cái này không ổn bạn ơi click dup là xong à.

 

[HeSanbi]

Cái này không ổn bạn ơi click dup là xong à.

Đành tạm thêm điều kiện cho code trên

If .Range("E" & i) <> "" And .Range("C" & i + 1) = "" Then

----------------------------------------------------------------------
Kiểm thử kết quả Mảng trong Immediate với hàm dbPrint
Đánh thứ tự ký tự bằng Hàm hoặc Code - Sử dụng toán chỉnh hợp

 

[chothadiem]

Cái này không ổn bạn ơi click dup là xong à.

Dạ, click dup là bị lỗi ạ! anh (chị) xem lại giúp em ạ!

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

Đành tạm thêm điều kiện cho code trên

If .Range("E" & i) <> "" And .Range("C" & i + 1) = "" Then

Em cám ơn ạ!

 

[chothadiem]

Đành tạm thêm điều kiện cho code trên

If .Range("E" & i) <> "" And .Range("C" & i + 1) = "" Then

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

Bạn thử thêm code này vào thử xem:

Sub Vd()
    Dim shdata As Worksheet
    Dim shInfor As Worksheet
    Set shInfor = Sheets("infor")
    Set shdata = Sheets("Data")
    Dim i As Long
    With shdata
        For i = .Range("E" & .Rows.Count).End(xlUp).Row To 1 Step -1
            If .Range("E" & i) <> "" Then
                Dim j As Long
                For j = 2 To shInfor.Range("A600").End(xlUp).Row
                    If Left(.Range("E" & i).Value, Len(shInfor.Range("A" & j).Value)) = shInfor.Range("A" & j).Value Then
                        shdata.Range("A" & i + 1 & ":A" & i + shInfor.Range("B" & j).Value).EntireRow.Insert
                        shdata.Range("C" & i + 1).Value = shInfor.Range("C" & j).Value
                        Exit For
                    End If
                Next
            End If
        Next
    End With
End Sub

Em cám ơn ạ!