Xin giúp đỡ chèn/xóa dòng có số liệu bằng 0 (1 người xem)

[lyly2626]

Như tiêu đề
Nhờ các anh/chị viết giùm đoạn code để thực hiện yêu cầu trong file đính kèm ạ!

 

[Let'GâuGâu]

Như tiêu đề
Nhờ các anh/chị viết giùm đoạn code để thực hiện yêu cầu trong file đính kèm ạ!

Option Explicit
Sub xoa_Zero()
Dim Sarr, Rarr(1 To 60000, 1 To 4) As Variant
Dim i, j, k, rw As Long
Sarr = Sheet1.[b3:e60000]

For i = 1 To UBound(Sarr)
    If Sarr(i, 1) <> "Total" Then

        If Sarr(i, 2) <> 0 Then
            k = k + 1
            Rarr(k, 1) = Sarr(i, 1)
            Rarr(k, 2) = Sarr(i, 2)
        End If
        If Sarr(i, 4) <> 0 Then
            j = j + 1
            Rarr(j, 3) = Sarr(i, 3)
            Rarr(j, 4) = Sarr(i, 4)
        End If
        If k > j Then rw = k Else rw = j
    Else
        Rarr(rw, 1) = Sarr(i, 1)
        Rarr(rw, 2) = Sarr(i, 2)
        Rarr(rw, 3) = Sarr(i, 3)
        Rarr(rw, 4) = Sarr(i, 4)
        Exit For
    End If

Next

If rw Then
With Sheet1
    .[G3:J60000].ClearContents
    .[g3].Resize(rw, 4) = Rarr
End With
End If

End Sub

 

[lyly2626]

Bạn ơi sửa giúp mình code chạy bị thiếu mất dòng cuối H109 ạ.

 

[Ba Tê]

Bạn ơi sửa giúp mình code chạy bị thiếu mất dòng cuối H109 ạ.

Bạn chạy thử sub này xem sao.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, K1 As Long, K2 As Long, Rws As Long
sArr = Range("B3", Range("B65536").End(xlUp).Offset(-1)).Resize(, 4).Value
ReDim dArr(1 To UBound(sArr), 1 To 4)
For I = 1 To UBound(sArr)
    If sArr(I, 2) <> 0 Then
        K1 = K1 + 1
        dArr(K1, 1) = sArr(I, 1): dArr(K1, 2) = sArr(I, 2)
    End If
    If Abs(sArr(I, 4)) > 0 Then
        K2 = K2 + 1
        dArr(K2, 3) = sArr(I, 3): dArr(K2, 4) = sArr(I, 4)
    End If
    Rws = IIf(K1 > K2, K1, K2)
Next I
Range("G3:J1000").ClearContents
Range("G3:J1000").Borders.LineStyle = 0
Range("G3").Resize(Rws, 4) = dArr
Range("G3").Resize(Rws + 2, 4).Borders.LineStyle = 1
With Range("G3").Offset(Rws + 1)
    .Value = "Total": .Offset(, 2).Value = "Total"
    .Offset(, 1) = "=SUM(R[" & -Rws - 1 & "]C:R[-1]C)": .Offset(, 3) = "=SUM(R[" & -Rws - 1 & "]C:R[-1]C)"
End With
End Sub

 

[Let'GâuGâu]

Bạn ơi sửa giúp mình code chạy bị thiếu mất dòng cuối H109 ạ.

Option Explicit
Sub xoa_Zero()
Dim Sarr, Rarr(1 To 60000, 1 To 4) As Variant
Dim i, j, k, rw As Long
Sarr = Sheet1.[b3:e60000]

For i = 1 To UBound(Sarr)
    If Sarr(i, 1) <> "Total" Then

        If Sarr(i, 2) <> 0 Then
            k = k + 1
            Rarr(k, 1) = Sarr(i, 1)
            Rarr(k, 2) = Sarr(i, 2)
        End If
        If Sarr(i, 4) <> 0 Then
            j = j + 1
            Rarr(j, 3) = Sarr(i, 3)
            Rarr(j, 4) = Sarr(i, 4)
        End If
        [COLOR=#0000ff]If k > j Then rw = k + 1 Else rw = j + 1[/COLOR]
    Else
        Rarr(rw, 1) = Sarr(i, 1)
        Rarr(rw, 2) = Sarr(i, 2)
        Rarr(rw, 3) = Sarr(i, 3)
        Rarr(rw, 4) = Sarr(i, 4)
        Exit For
    End If

Next

If rw Then
With Sheet1
    .[G3:J60000].ClearContents
    .[g3].Resize(rw, 4) = Rarr
End With
End If

End Sub