Giúp code Insert thêm dòng, tùy điều kiện (1 người xem)

[hoanglocphat]

Chào các bạn!
Tôi có tìm trên diễn đàn code Insert thêm dòng nhưng chưa thấy code nào phù hợp, nhờ các bạn giúp như sau:
Ví dụ tại sheet1: Tại cột AA từ dòng số 9 trở xuống
Tôi nhập cell AA10, AA11,AA12 là 1,2,3 thì sau khi chạy code nó sẽ chèn thêm 1,2,3 dòng ở fía dưới
kết quả sau khi chạy code nó sẽ giống như sheet "Ketqua"
Cảm ơn các bạn!

 

[Ba Tê]

Chào các bạn!
Tôi có tìm trên diễn đàn code Insert thêm dòng nhưng chưa thấy code nào phù hợp, nhờ các bạn giúp như sau:
Ví dụ tại sheet1: Tại cột AA từ dòng số 9 trở xuống
Tôi nhập cell AA10, AA11,AA12 là 1,2,3 thì sau khi chạy code nó sẽ chèn thêm 1,2,3 dòng ở fía dưới
kết quả sau khi chạy code nó sẽ giống như sheet "Ketqua"
Cảm ơn các bạn!

Thử chạy code này coi sao, nhanh hay chậm thì không biết à nghe

Public Sub HicHic()
Dim R As Long, Num As Long, I As Long
R = Range("AA" & Cells.Rows.Count).End(xlUp).Row
For I = R To 9 Step -1
    Num = Range("AA" & I).Value
    If Num > 0 Then
        Rows(I + 1 & ":" & I + Num).Insert
    End If
Next I
End Sub

 

[hoanglocphat]

Thử chạy code này coi sao, nhanh hay chậm thì không biết à nghe

Public Sub HicHic()
Dim R As Long, Num As Long, I As Long
R = Range("AA" & Cells.Rows.Count).End(xlUp).Row
For I = R To 9 Step -1
    Num = Range("AA" & I).Value
    If Num > 0 Then
        Rows(I + 1 & ":" & I + Num).Insert
    End If
Next I
End Sub

Em thấy code cũng chạy nhanh mà anh!

 

[Quang_Hải]

Thêm 1 cách

Sub chendong()
Dim arr(), i, j, Res(), n, k
arr = [A8].CurrentRegion.Value
ReDim Res(1 To 1000, 1 To UBound(arr, 2))
k = 1
For i = 2 To UBound(arr)
   k = k + n
   For j = 1 To UBound(arr, 2)
      Res(k, j) = arr(i, j)
   Next
   If arr(i, 27) = 0 Then n = 1
   If arr(i, 27) > 0 Then n = arr(i, 27) + 1
Next
[A9].Resize(k, UBound(arr, 2)) = Res
End Sub

 

[Ba Tê]

Thêm 1 cách

Sub chendong()
Dim arr(), i, j, Res(), n, k
arr = [A8].CurrentRegion.Value
ReDim Res(1 To 1000, 1 To UBound(arr, 2))
k = 1
For i = 2 To UBound(arr)
   k = k + n
   For j = 1 To UBound(arr, 2)
      Res(k, j) = arr(i, j)
   Next
   If arr(i, 27) = 0 Then n = 1
   If arr(i, 27) > 0 Then n = arr(i, 27) + 1
Next
[A9].Resize(k, UBound(arr, 2)) = Res
End Sub

Bớt được 2 dòng, hổng biết nhanh hay chậm.
Híc!

Public Sub Hic()
Dim sArr(), dArr(), i As Long, j As Long, k As Long
sArr = [A8].CurrentRegion.Value
ReDim dArr(1 To 65536, 1 To UBound(sArr, 2))
For i = 2 To UBound(sArr, 1)
    k = k + 1
    For j = 1 To UBound(sArr, 2)
        dArr(k, j) = sArr(i, j)
    Next j
    k = k + sArr(i, 27)
Next i
[A9].Resize(k, UBound(sArr, 2)) = dArr
End Sub