Hỏi hàm insert dòng theo điều kiện.

[newex]

EM có 1 file dữ liệu > 1.000 dòng đang cần isert khoảng 30 dòng trắng giữa các dòng dữ liệu có sẵn , các bác có cách nào giúp em với ?

 

[phulien1902]

EM có 1 file dữ liệu > 1.000 dòng đang cần isert khoảng 30 dòng trắng giữa các dòng dữ liệu có sẵn , các bác có cách nào giúp em với ?

Bạn tham khảo cái này nhé

Sub newex()
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    Dim i As Integer
    Dim j As Integer
    For j = 2000 To 2 Step -1
        For i = 1 To 30
            Rows(j).Insert
        Next
    Next
    
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

- Bạn xem File đính kèm nhé

 

[hpkhuong]

Bạn tham khảo cái này nhé

Sub newex()
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    Dim i As Integer
    Dim j As Integer
    For j = 2000 To 2 Step -1
        For i = 1 To 30
            Rows(j).Insert
        Next
    Next
    
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

- Bạn xem File đính kèm nhé

Dự là code này sẽ chạy lâu bà cố...........

 2000 thay bằng counta(vùng)

để giới hạn lại khi vòng lặp for next sẽ cải thiện tốc độ

Sub newex()
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    Dim i As Integer, d As Long
    Dim j As Integer
    d = Application.WorksheetFunction.CountA(Sheet1.Range("A1:A2000"))
    For j = d To 2 Step -1
        For i = 1 To 30
            Rows(j).Insert
        Next
    Next
    
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

 

[giangleloi]

Dự là code này sẽ chạy lâu bà cố...........
để giới hạn lại khi vòng lặp for next sẽ cải thiện tốc độ

Cái này chắc chậm hơn. hehe.....

Sub newex()
Dim lr As Long
   lr = Range("A" & Rows.Count).End(3).Row
   Rows(Int(lr / 2) + 1 & ":" & Int(lr / 2) + 30).EntireRow.Insert
End Sub

Xen giữa từng dòng thì như thế này:

Sub newex()
Dim lr As Long, i
   lr = Range("A" & Rows.Count).End(3).Row
     For i = lr To 2 Step -1
       Rows(i & ":" & i + 29).EntireRow.Insert
     Next
End Sub

 

[phulien1902]

Cảm ơn bạn hpkhuong, tốc độ cực nhanh.

 

[SA_DQ]

Sao lại là hàm kia chứ? Fải là 1 macro, như vầy mới fải đạo!

Option Explicit
Sub Insert30RowsIn1000Rows()
 Dim J As Byte, Tmp As Integer, BD As Integer
 
 Randomize:                     BD = 999
 For J = 1 To 30
    Tmp = 30 * Rnd() \ 1
    Rows(BD - Tmp & ":" & BD - Tmp).Insert
    BD = BD - Tmp
 Next J
End Sub

 

[newex]

em cảm ơn các bác. em đã thử cách từng cách của các bác