Mọi người giúp chèn dòng tự động theo bảng dữ liệu với ạ

[songlam294]

Mọi người giúp mình cái code chèn dòng tự động theo số lượng ở cột E với ạ (như sheet kết quả). Xin cảm ơn mọi người.

 

[huuthang_bd]

Mọi người giúp mình cái code chèn dòng tự động theo số lượng ở cột E với ạ (như sheet kết quả). Xin cảm ơn mọi người.

Bạn thử code này

Const DongDau As Long = 3
Sub ChenDong()
Dim MangSoLuong As Variant, i As Long
Application.ScreenUpdating = False
MangSoLuong = Range("E" & (DongDau), Range("E65536").End(xlUp)).Value
For i = UBound(MangSoLuong, 1) To 1 Step -1
    If MangSoLuong(i, 1) > 1 Then
        Cells(i + DongDau, 3).Resize(MangSoLuong(i, 1) - 1).EntireRow.Insert xlDown
        Cells(i + DongDau - 1, 3).Resize(MangSoLuong(i, 1), 2).FillDown
    End If
Next
Application.ScreenUpdating = True
End Sub

 

[snow25]

Mọi người giúp mình cái code chèn dòng tự động theo số lượng ở cột E với ạ (như sheet kết quả). Xin cảm ơn mọi người.

Bạn thử code này.

Sub linhtinh()
    Dim arr, arr1, a As Long, i As Long, j As Long, lr As Long, k As Long
    With Sheets("dulieu")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         If lr < 3 Then Exit Sub
         arr = .Range("A3:E" & lr).Value
         ReDim arr1(1 To UBound(arr) * 20, 1 To 5)
         For i = 1 To UBound(arr)
             a = a + 1
             For j = 1 To 5
                 arr1(a, j) = arr(i, j)
             Next j
             For k = 2 To arr(i, 5)
                 a = a + 1
                 arr1(a, 3) = arr(i, 3)
                 arr1(a, 4) = arr(i, 4)
             Next k
         Next i
   End With
   With Sheets("ket qua")
        lr = .Range("C" & Rows.Count).End(xlUp).Row
        If lr > 2 Then .Range("A3:E" & lr).ClearContents
        If a Then .Range("A3:E3").Resize(a).Value = arr1
   End With
End Sub

 

[songlam294]

Cảm

Bạn thử code này

Const DongDau As Long = 3
Sub ChenDong()
Dim MangSoLuong As Variant, i As Long
Application.ScreenUpdating = False
MangSoLuong = Range("E" & (DongDau), Range("E65536").End(xlUp)).Value
For i = UBound(MangSoLuong, 1) To 1 Step -1
    If MangSoLuong(i, 1) > 1 Then
        Cells(i + DongDau, 3).Resize(MangSoLuong(i, 1) - 1).EntireRow.Insert xlDown
        Cells(i + DongDau - 1, 3).Resize(MangSoLuong(i, 1), 2).FillDown
    End If
Next
Application.ScreenUpdating = True
End Sub

Cảm ơn anh nhiều! Nhờ anh bổ sung thêm ở cột H, Số tứ tự được cộng thêm 1 như sheet kết quả luôn với ạ.

 

[huuthang_bd]

Cảm

Cảm ơn anh nhiều! Nhờ anh bổ sung thêm ở cột H, Số tứ tự được cộng thêm 1 như sheet kết quả luôn với ạ.

Vậy bạn thử code này

Const DongDau As Long = 3
Sub ChenDong()
Dim MangSoLuong As Variant, i As Long
Application.ScreenUpdating = False
MangSoLuong = Range("E" & (DongDau), Range("E65536").End(xlUp)).Value
For i = UBound(MangSoLuong, 1) To 1 Step -1
    If MangSoLuong(i, 1) > 1 Then
        Cells(i + DongDau, 3).Resize(MangSoLuong(i, 1) - 1).EntireRow.Insert xlDown
        Cells(i + DongDau - 1, 3).Resize(MangSoLuong(i, 1), 2).FillDown
    End If
Next
With Range("A" & (DongDau), Range("B65536").End(xlUp).Offset(, -1))
    .Value = Evaluate("=Row(" & .Offset(1 - DongDau).Address & ")")
End With
Application.ScreenUpdating = True
End Sub