Không thể hiện dòng trống khi xuất kết quả VBA Excel

Chia sẻ bởi:hands

★★★★★

‹ Kiểm tra ngày nghỉ [ Python và ứng dụng ] Phần... ›

Quảng cáo

Nhờ các anh/chị chỉ giúp em, em đang làm sheet "tổng hợp chi tiết công nợ" từ 2 sheet "phát sinh" và "thanh toán". Tham chiếu và lọc dữ liệu qua mã khách hàng. Chỉ giúp em code VBA để khi output không thể hiện dòng trống được không ạ. Em cảm ơn nhiều ạ

Sub loccongno()
'Buoc 1: Loc du lieu sheet phat sinh
Dim arr(), kq(), a As Long, i As Long, ir As Long
Dim shnguon As Worksheet, shdich As Worksheet

Set shnguon = Sheets("phat sinh")
Set shdich = Sheets("chi tiet cong no")

With shdich
    makh = shdich.Range("C10").Value
End With

With shnguon
    ir = .Range("A" & Rows.Count).End(xlUp).Row
    arr = .Range("A5:V" & ir).Value
    ReDim kq(1 To 10000, 1 To 8)
End With

For i = 1 To UBound(arr, 1)
    If arr(i, 3) = makh Then
        a = a + 1
        kq(a, 1) = arr(i, 1) 'ngay thang
        kq(a, 2) = arr(i, 2) 'so hoa don
        kq(a, 3) = arr(i, 5) 'noi dung
        kq(a, 4) = arr(i, 11) 'so tien phai thanh toan
        kq(a, 5) = ""
        kq(a, 6) = arr(i, 21) 'phan loai chi phi
        kq(a, 7) = arr(i, 20) 'phap nhan
        kq(a, 8) = arr(i, 22) 'ghi chu
    End If

If arr(i, 3) <> makh Then
        a = a + 1
        kq(a, 1) = ""
        kq(a, 2) = ""
        kq(a, 3) = ""
        kq(a, 4) = ""
        kq(a, 5) = ""
        kq(a, 6) = ""
        kq(a, 7) = ""
        kq(a, 8) = ""
    End If
Next i
'Buoc 2: Loc du lieu sheet thanh toan
Set shnguon = Sheets("thanh toan")
    With shnguon
        ir = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A5:I" & ir).Value
    End With
For i = 1 To UBound(arr, 1)
    If arr(i, 2) = makh Then
        a = a + 1
        kq(a, 1) = arr(i, 1) 'ngay thang
        kq(a, 2) = arr(i, 5) 'so hoa don
        kq(a, 3) = arr(i, 4) 'noi dung
        kq(a, 4) = ""
        kq(a, 5) = arr(i, 6) 'so tien thanh toan
        kq(a, 6) = ""
        kq(a, 7) = arr(i, 8) 'phap nhan
        kq(a, 8) = arr(i, 9) 'ghi chu
    End If

If arr(i, 2) <> makh Then
        a = a + 1
        kq(a, 1) = ""
        kq(a, 2) = ""
        kq(a, 3) = ""
        kq(a, 4) = ""
        kq(a, 5) = ""
        kq(a, 6) = ""
        kq(a, 7) = ""
        kq(a, 8) = ""
    End If
Next i

'Output dan ket qua ra sheet chi tiet cong no
    If a > 10000 Then
        MsgBox "du lieu vuot qua 10000 dong!", vbCritical
        Exit Sub
    End If

If a > 0 Then
        With shdich
            .Range("A17:A10016").ClearContents
            .Range("A17").Resize(a, 8).Value = kq
        End With
     End If

End Sub

Sub LocCongNo()
'Buoc 1: Loc du lieu sheet phat sinh '
Dim Arr(), KQ(), A As Long, I As Long, iR As Long
Dim ShNguon As Worksheet, ShDich As Worksheet

Set ShNguon = Sheets("PhatSinh")
Set ShDich = Sheets("CongNo")
'With ShDich '
MaKH = ShDich.Range("C10").Value
'End With '
With ShNguon
iR = .Range("A" & Rows.Count).End(xlUp).Row
Arr = .Range("A5:V" & iR).Value
ReDim KQ(1 To 10000, 1 To 8)
End With
For I = 1 To UBound(Arr, 1)
If Arr(I, 3) = MaKH Then
A = A + 1
KQ(A, 1) = Arr(I, 1) 'ngay thang '
KQ(A, 2) = Arr(I, 2) 'so hoa don '
KQ(A, 3) = Arr(I, 5) 'noi dung '
KQ(A, 4) = Arr(I, 11) 'so tien phai thanh toan '
' KQ(A, 5) = "" '
KQ(A, 6) = Arr(I, 21) 'phan loai chi phi '
KQ(A, 7) = Arr(I, 20) 'phap nhan '
KQ(A, 8) = Arr(I, 22) 'ghi chu '
End If
If Arr(I, 3) <> MaKH Then
21 ' A = A + 1 '
' KQ(A, 1) = "": KQ(A, 2) = ""
' KQ(A, 3) = "": KQ(A, 4) = ""
' KQ(A, 5) = "": KQ(A, 6) = ""
' KQ(A, 7) = "": KQ(A, 8) = ""
End If
Next I
'Buoc 2: Loc du lieu sheet thanh toan
Set ShNguon = Sheets("ThToan")
With ShNguon
iR = .Range("A" & Rows.Count).End(xlUp).Row
Arr = .Range("A5:I" & iR).Value
End With
For I = 1 To UBound(Arr, 1)
If Arr(I, 2) = MaKH Then
A = A + 1
KQ(A, 1) = Arr(I, 1) 'ngay thang '
KQ(A, 2) = Arr(I, 5) 'so hoa don '
KQ(A, 3) = Arr(I, 4) 'noi dung '
KQ(A, 4) = ""
KQ(A, 5) = Arr(I, 6) 'so tien thanh toan '
KQ(A, 6) = ""
KQ(A, 7) = Arr(I, 8) 'phap nhan '
KQ(A, 8) = Arr(I, 9) 'ghi chu '
End If
If Arr(I, 2) <> MaKH Then
46 ' A = A + 1: KQ(A, 1) = "" '
' KQ(A, 2) = "": KQ(A, 3) = ""
' KQ(A, 4) = "": KQ(A, 5) = ""
' KQ(A, 6) = "": KQ(A, 7) = ""
' KQ(A, 8) = ""
End If
Next I
'Output dan ket qua ra sheet chi tiet cong no '
If A > 10000 Then
MsgBox "du lieu vuot qua 10000 dong!", vbCritical
Exit Sub
End If
If A > 0 Then
With ShDich
.Range("A17:A10016").ClearContents
.Range("A17").Resize(A, 8).Value = KQ
End With
End If
End Sub

[Chú ý: Mình đã đổi tên các trang tính; Bạn có thể xài hay đổi lại cho khớp.]

www.giaiphapexcel.com/diendan/threads/kh%C3%B4ng-th%E1%BB%83-hi%E1%BB%87n-d%C3%B2ng-tr%E1%BB%91ng-khi-xu%E1%BA%A5t-k%E1%BA%BFt-qu%E1%BA%A3-vba-excel.163914/#post-1093904