Xin code VBA xuất dữ liệu điều kiện tổng lớn hơn 0

[Thanh Binh111]

Xin chào mọi người！

Mình có bài toán này nhờ mọi người giúp đỡ:

-Dữ liệu ban đầu của mình là một biểu liệt kê các tài khoản và số tiền tương ứng mỗi ngày (như sheet 1)




-Nhu cầu của mình là: nhờ viết hộ VBA để xuất ra một file mới chứa bảng dữ liệu chỉ chưa những tài khoản có tổng số tiền mỗi ngày cộng lại lớn hơn 0 (như sheet 2).


Xin cảm ơn rất nhiều！

 

[BuiQuangThuan]

Xin chào mọi người！

Mình có bài toán này nhờ mọi người giúp đỡ:

-Dữ liệu ban đầu của mình là một biểu liệt kê các tài khoản và số tiền tương ứng mỗi ngày (như sheet 1)
-Nhu cầu của mình là: nhờ viết hộ VBA để xuất ra một file mới chứa bảng dữ liệu chỉ chưa những tài khoản có tổng số tiền mỗi ngày cộng lại lớn hơn 0 (như sheet 2).

Xin cảm ơn rất nhiều！

Bạn tạo thêm cột Tổng ở cuối cùng rồi thu macro lọc lấy cột tổng >0 là có kết quả mà

 

[Thanh Binh111]

Bạn tạo thêm cột Tổng ở cuối cùng rồi thu macro lọc lấy cột tổng >0 là có kết quả mà

Vâng, mình hiểu ý bạn, nhưng dữ liệu mình thực tế số dòng rất nhiều, và công việc mỗi ngày đều lặp lại, nên muốn nhờ mọi người hỗ trợ viết đoạn code tối ưu để rút ngắn thời gian tổng hợp ạ·

 

[BuiQuangThuan]

Vâng, mình hiểu ý bạn, nhưng dữ liệu mình thực tế số dòng rất nhiều, và công việc mỗi ngày đều lặp lại, nên muốn nhờ mọi người hỗ trợ viết đoạn code tối ưu để rút ngắn thời gian tổng hợp ạ·

Thì có nói là Tạo thêm Cột tổng rồi thu lại macro lọc cột tổng đó để trả kết quả ra file mới mà. Rồi lần sau cứ thế bấm nút là nó ra à

 

[Thanh Binh111]

Thì có nói là Tạo thêm Cột tổng rồi thu lại macro lọc cột tổng đó để trả kết quả ra file mới mà. Rồi lần sau cứ thế bấm nút là nó ra à

Vâng, tại bản thân mình thấy cách đó chưa tối ưu ạ, mình đã viết được một đoạn code, nhưng đang vướng chỗ xác định tổng của mỗi hội viên, nên chưa chạy được ạ, nhờ bạn cũng như mọi người hỗ trợ sửa giùm ạ, cảm ơn!


Sub EXPORT()
Dim filename As String
Dim i As Long, j As Integer, K As Integer, Sum As Integer, lr As Long, R As Long, lc As Long, l1 As Long, c As Long
Dim MyName As Name

ThisWorkbook.Sheets("DAILY").Copy
On Error Resume Next
With ActiveWorkbook.ActiveSheet

lr = .Range("A" & Rows.Count).End(xlUp).Row
sArr = .Range("A3:AI" & lr).Value

ReDim dArr(1 To UBound(sArr), 1 To 35)

R = 0
For i = 1 To UBound(sArr)

If WorksheetFunction.Sum(.Range("C" & i + 2 & ":AI" & i + 2)).Value > 0 Then
R = R + 1
For j = 1 To 35
dArr(R, j) = sArr(i, j)
Next j
End If
Next i
.Range("A3:AJ" & lr + 1).ClearContents
.Range("A3").Resize(R, 35).Value = dArr

For Each MyName In .Names
MyName.Delete
Next
End With

MsgBox "Successful export of new workbook"

End Sub

 

[BuiQuangThuan]

Vâng, tại bản thân mình thấy cách đó chưa tối ưu ạ, mình đã viết được một đoạn code, nhưng đang vướng chỗ xác định tổng của mỗi hội viên, nên chưa chạy được ạ, nhờ bạn cũng như mọi người hỗ trợ sửa giùm ạ, cảm ơn!

Hãy gửi nguyên file có code qua đây. Mình sẽ sửa giúp bạn cho

 

[Thanh Binh111]

Hãy gửi nguyên file có code qua đây. Mình sẽ sửa giúp bạn cho

Vâng mình gửi file nhờ bạn sửa hộ ạ, cảm ơn.

 

[BuiQuangThuan]

Vâng mình gửi file nhờ bạn sửa hộ ạ, cảm ơn.

Bạn tự bẫy lỗi lấy nhé

Sub EXPORT()
    Dim iRow&, iCol&, Wb As Workbook
    With Sheets("DaiLy")
        iRow = .Range("A" & Rows.Count).End(3).Row
        iCol = .Cells(1, Columns.Count).End(1).Column
        .Cells(1, iCol + 1).Value = "Total"
        .Cells(2, iCol + 1).Resize(iRow - 2).FormulaR1C1 = "=SUM(RC[-" & iCol - 2 & "]:RC[-1])"
        .Range("A1").Resize(iRow, iCol + 1).AutoFilter iCol + 1, ">0"
        .Range("A1").Resize(iRow, iCol).SpecialCells(12).Copy
        Set Wb = Workbooks.Add
        Wb.ActiveSheet.Range("A1").PasteSpecial xlPasteAll
        If .AutoFilterMode = True Then .AutoFilterMode = False
        .Columns(iCol + 1).ClearContents
    End With
    MsgBox "Successful export of new workbook"
End Sub

 

[Thanh Binh111]

Bạn tự bẫy lỗi lấy nhé

Sub EXPORT()
    Dim iRow&, iCol&, Wb As Workbook
    With Sheets("DaiLy")
        iRow = .Range("A" & Rows.Count).End(3).Row
        iCol = .Cells(1, Columns.Count).End(1).Column
        .Cells(1, iCol + 1).Value = "Total"
        .Cells(2, iCol + 1).Resize(iRow - 2).FormulaR1C1 = "=SUM(RC[-" & iCol - 2 & "]:RC[-1])"
        .Range("A1").Resize(iRow, iCol + 1).AutoFilter iCol + 1, ">0"
        .Range("A1").Resize(iRow, iCol).SpecialCells(12).Copy
        Set Wb = Workbooks.Add
        Wb.ActiveSheet.Range("A1").PasteSpecial xlPasteAll
        If .AutoFilterMode = True Then .AutoFilterMode = False
        .Columns(iCol + 1).ClearContents
    End With
    MsgBox "Successful export of new workbook"
End Sub

Code dùng rất OK, xin cảm ơn bạn rất nhiều đã hỗ trợ ạ!!!