[Hỏi-Trợ giúp] Tạo dòng trống giữa các dòng có Điều Kiện !!

riotocxoan

Yêu THVBA
Hi ! Mọi người mình đang bị bí cách giải quyết .Mong mọi người giúp đỡ


Mình có 1 file excel như hình :
Bạn cần đăng nhập để thấy hình ảnh


Mình đã tạo dòng trống giữa các điều kiện A2 # A3 and B2 # B3 thì sẽ tạo 1 dòng trống nữa như hình và code ở dưới:

Bạn cần đăng nhập để thấy hình ảnh


Giờ mình cần chèn thêm 1 điệu kiện ở cột E , nếu số đếm lớn hơn 10 thì tạo 1 dòng trống nữa :

Bạn cần đăng nhập để thấy hình ảnh


Mình cảm ơn mọi người đã giúp .

Mã:
Sub Help()

Dim j As Long
Dim wb As Workbook

Set wb = ThisWorkbook

With wb.Sheets(1)

    j = 2

    While Cells(j, 1) <> ""
                If Cells(j, 1).Value = Cells(j + 1, 1).Value And _
                Cells(j, 2).Value = Cells(j + 1, 2).Value Then
                    GoTo Next2
                        Else
                    Cells(j + 1, 1).EntireRow.Insert
                    j = j + 1
                End If
Next2:
            j = j + 1
    Wend
End With

Set wb = Nothing

End Sub
 

jd86

Yêu THVBA
riotocxoan
Bạn thử code bên dưới xem có được không nhé !
Mã:
Sub Help_sua()
Dim j As Long
Dim sh As String
j = 2
sh = "File3"
    Do While Sheets(sh).Cells(j, 1) <> ""
        If (Sheets(sh).Cells(j, 1).Value <> Sheets(sh).Cells(j + 1, 1).Value And Sheets(sh).Cells(j, 2).Value <> Sheets(sh).Cells(j + 1, 2).Value) _
            Or (Sheets(sh).Cells(j, 6).Value > 9) Then
                Sheets(sh).Rows(j + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                j = j + 1
        End If
        j = j + 1
    Loop
    MsgBox ("ok")
End Sub
 

riotocxoan

Yêu THVBA
riotocxoan
Bạn thử code bên dưới xem có được không nhé !
Mã:
Sub Help_sua()
Dim j As Long
Dim sh As String
j = 2
sh = "File3"
    Do While Sheets(sh).Cells(j, 1) <> ""
        If (Sheets(sh).Cells(j, 1).Value <> Sheets(sh).Cells(j + 1, 1).Value And Sheets(sh).Cells(j, 2).Value <> Sheets(sh).Cells(j + 1, 2).Value) _
            Or (Sheets(sh).Cells(j, 6).Value > 9) Then
                Sheets(sh).Rows(j + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                j = j + 1
        End If
        j = j + 1
    Loop
    MsgBox ("ok")
End Sub
Cám ơn bạn nha , cột 6 mình đánh số thứ tự cho mọi người dễ hình dung . Nhưng mà dựa vào đó thì mình cũng có ý tưởng để thực hiện rồi . Cám ơn bạn nhiều
 
Top