Chèn thêm dòng kèm nội dung bằng vòng lặp For

[kobebryant]

Em có 2 sheet. Trong đó Sheet 1 sẽ tìm dữ liệu từ sheet 2 để bổ sung thêm vào sheet 1 bằng cách cứ mỗi dữ liệu tìm thấy sẽ chèn thêm 1 dòng kèm nội dung.
Em viết vòng lặp mà lúc thì nó chạy ok, lúc thì nội dung của dòng vừa chèn thêm nó chạy tá lả, em nghĩ là do khi em cố định LastRow, 1 dòng mới chèn thêm thì LastRow thay đổi nên hình như nó mới bị lỗi vậy.
Cho em hỏi có cách nào xác định LastRow cũ và LastRow mới không ạ vì có lúc em cần dùng LastRow cũ nữa ạ.
Em xin gửi file đính kèm

 

[huuthang_bd]

Như đã nói, tôi viết code cho bài toán của bạn chứ không trả lời câu hỏi xác định LastRow cũ và LastRow mới ở bài 1 của bạn.

Sub Macro1()
Const firstRow As Long = 3
Dim lastRow As Long, aData As Variant, aResult() As Variant, sFormula As String, i As Long, k As Long, x As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
lastRow = Range("lastrow").Row
sFormula = "=SUMIF(R" & firstRow & "C[-GPE]:R" & (lastRow - 1) & "C[-GPE],RC[-GPE],R" & firstRow & "C:R" & (lastRow - 1) & "C)"
aData = Sheets("ADB").Range("A1:A12").Value
ReDim aResult(1 To UBound(aData, 1), 1 To 4)
For i = 1 To UBound(aData, 1)
    If UCase(aData(i, 1)) Like "[CD]*" Then
        k = k + 1
        x = InStr(1, "CD", Left(aData(i, 1), 1), vbTextCompare)
        aResult(k, 1) = "Chuyen bay " & aData(i, 1)
        aResult(k, 1 + x) = aData(i, 1)
        aResult(k, 4 - x) = Choose(x, "SG-HN", "DN-SG")
        aResult(k, 4) = Replace(sFormula, "GPE", CStr(3 - x))
    End If
Next
If k > 0 Then
    Range("lastrow").Resize(k).EntireRow.Insert
    Cells(lastRow, 2).Resize(k, 4).FormulaR1C1 = aResult
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[kobebryant]

Như đã nói, tôi viết code cho bài toán của bạn chứ không trả lời câu hỏi xác định LastRow cũ và LastRow mới ở bài 1 của bạn.

Sub Macro1()
Const firstRow As Long = 3
Dim lastRow As Long, aData As Variant, aResult() As Variant, sFormula As String, i As Long, k As Long, x As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
lastRow = Range("lastrow").Row
sFormula = "=SUMIF(R" & firstRow & "C[-GPE]:R" & (lastRow - 1) & "C[-GPE],RC[-GPE],R" & firstRow & "C:R" & (lastRow - 1) & "C)"
aData = Sheets("ADB").Range("A1:A12").Value
ReDim aResult(1 To UBound(aData, 1), 1 To 4)
For i = 1 To UBound(aData, 1)
    If UCase(aData(i, 1)) Like "[CD]*" Then
        k = k + 1
        x = InStr(1, "CD", Left(aData(i, 1), 1), vbTextCompare)
        aResult(k, 1) = "Chuyen bay " & aData(i, 1)
        aResult(k, 1 + x) = aData(i, 1)
        aResult(k, 4 - x) = Choose(x, "SG-HN", "DN-SG")
        aResult(k, 4) = Replace(sFormula, "GPE", CStr(3 - x))
    End If
Next
If k > 0 Then
    Range("lastrow").Resize(k).EntireRow.Insert
    Cells(lastRow, 2).Resize(k, 4).FormulaR1C1 = aResult
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Cám ơn anh, chạy đẹp quá