Thêm dòng trắng giữa các số dòng chứng từ cách nhau bằng code VBA (1 người xem)

[thinhnx22]

Chào các anh chị, Tôi có file excel muốn thêm dòng trắng tự động giữa các số chứng từ cách nhau. Ví dụ từ A2: A6 là từ chứng từ 138 đến 142. Bây giờ ô A7 là: số chứng từ 149. Bây giờ tôi muốn giữa dòng 6 và 7, thêm 7 dòng trắng (149-142=7) thì không biết có được không. Tôi chỉ cần thêm dòng trắng thôi. Tương tự với số chứng từ tiếp theo. Tôi gửi file đính kèm, nhờ các anh chị giúp đỡ. Trân trọng cảm ơn

 

[nghiaphuc]

Chào các anh chị, Tôi có file excel muốn thêm dòng trắng tự động giữa các số chứng từ cách nhau. Ví dụ từ A2: A6 là từ chứng từ 138 đến 142. Bây giờ ô A7 là: số chứng từ 149. Bây giờ tôi muốn giữa dòng 6 và 7, thêm 7 dòng trắng (149-142=7) thì không biết có được không. Tôi chỉ cần thêm dòng trắng thôi. Tương tự với số chứng từ tiếp theo. Tôi gửi file đính kèm, nhờ các anh chị giúp đỡ. Trân trọng cảm ơn

Bạn dùng code này nhé:
[GPECODE=vb]Sub ChenDong()
Dim Cll As Range
Set Cll = [A65000].End(xlUp)
Do While Cll.Row > 2
If Cll - Cll.Offset(-1) > 1 Then Cll.Resize(Cll - Cll.Offset(-1) - 1).EntireRow.Insert
Set Cll = Cll.Offset(-1)
Loop
End Sub[/GPECODE]
Mà từ 142 đến 149 thì chèn thêm 6 dòng trống thôi chứ nhỉ, sao lại là 7 dòng? Nếu đúng là 7 dòng thì bạn xóa cái số -1 ở cuối dòng lệnh thứ 5 đi là được.

 

[thinhnx22]

Bạn dùng code này nhé:
[GPECODE=vb]Sub ChenDong()
Dim Cll As Range
Set Cll = [A65000].End(xlUp)
Do While Cll.Row > 2
If Cll - Cll.Offset(-1) > 1 Then Cll.Resize(Cll - Cll.Offset(-1) - 1).EntireRow.Insert
Set Cll = Cll.Offset(-1)
Loop
End Sub[/GPECODE]
Mà từ 142 đến 149 thì chèn thêm 6 dòng trống thôi chứ nhỉ, sao lại là 7 dòng? Nếu đúng là 7 dòng thì bạn xóa cái số -1 ở cuối dòng lệnh thứ 5 đi là được.

Hay quá, đúng ý mình rồi, đúng là 6 dòng, cảm ơn bạn nhiều nhé.

 

[SA_DQ]

Hay quá, đúng là 6 dòng, cảm ơn bạn nhiều nhé.

Thêm 1 cách nữa để tham khảo:

Option Explicit
Sub ThemDong()
 Dim J As Long, Rws As Long, Tmp As Byte, W As Long
 Dim Arr()
 
 Arr() = Range([A3], [A3].End(xlDown)).Value
 Rws = UBound(Arr())
 ReDim dArr(1 To 9 * Rws, 1 To 1) As String
 Do
    J = J + 1
    On Error Resume Next
    Tmp = Arr(J + 1, 1) - Arr(J, 1)
    W = W + 1
    dArr(W, 1) = Right("000000" & CStr(Arr(J, 1)), 7)
    If Tmp > 1 Then W = W + Tmp - 1
    If J = UBound(Arr()) Then Exit Do
 Loop
 [A2].Resize(W).Value = dArr()
End Sub