Giúp em một Macro xoá dòng theo điều kiện.

anhyan130902 · 25/5/11

Em có 1 bàng dữ liệu với 2 cột như sau ( file đính kèm )
Bây giờ em cần 1 macro theo yêu cầu sau
-Xóa hết những dữ liệu tại những ô không phải là số, và có giá trị bằng 0 sao cho tất cả các ô chứa dữ liệu là liền nhau
-Tại cột C1 đếm số lần xuất hiện của B1 tại cột A
-Tại cột D1 đếm số lần xuất hiện của B1 tại cột B
--> làm tương tự với các ô B2,B3,...,Bn
Sau đó, Với D1<=C1 thì xóa giá trị của B1 của cột A và cột B tương ứng ứng với D1 . Ví dụ : B1=500.000
Số lần xuất hiện tại cột A và B tương ứng là : 4 và 3( D1=3, C1=4), thì xóa 3 lần số tiền 500.000 tại cột A và B
Với D1>C1, xóa giá trị của B1 của cột A và B tương ứng với C1. Ví dụ B1 = 1.000.000, D1=5,C1=3 thì xóa 3 lần 1.000.000 tại côt A và B
Kính nhờ các bác cao thủ giúp đỡ. Em xin chân thành cảm ơn!

huuthang_bd · 25/5/11

anhyan130902 đã viết:
Em có 1 bàng dữ liệu với 2 cột như sau ( file đính kèm )
Bây giờ em cần 1 macro theo yêu cầu sau
-Xóa hết những dữ liệu tại những ô không phải là số, và có giá trị bằng 0 sao cho tất cả các ô chứa dữ liệu là liền nhau
-Tại cột C1 đếm số lần xuất hiện của B1 tại cột A
-Tại cột D1 đếm số lần xuất hiện của B1 tại cột B
--> làm tương tự với các ô B2,B3,...,Bn
Sau đó, Với D1<=C1 thì xóa giá trị của B1 của cột A và cột B tương ứng ứng với D1 . Ví dụ : B1=500.000
Số lần xuất hiện tại cột A và B tương ứng là : 4 và 3( D1=3, C1=4), thì xóa 3 lần số tiền 500.000 tại cột A và B
Với D1>C1, xóa giá trị của B1 của cột A và B tương ứng với C1. Ví dụ B1 = 1.000.000, D1=5,C1=3 thì xóa 3 lần 1.000.000 tại côt A và B
Kính nhờ các bác cao thủ giúp đỡ. Em xin chân thành cảm ơn!

Có phải bạn làm cái này để quản lý công nợ không? Tôi e rằng không ăn thua.
Hỏi lại một chút: Trong 5 ô 1.000.000, xóa 3 ô thì xóa ô nào giữ ô nào?

anhyan130902 · 25/5/11

Dạ chỉ cần xó cho em là được rồi, bởi vì em cần là cần tinh chỉnh đến bước cuối cùng để tìm phân biệt được món nào em đã xử lý xong Nợ và Có --> còn tìm ra món đó của ngày nào? của ai thì em đã có cách

huuthang_bd · 25/5/11

Macro của bạn đây

PHP:

Sub GPE()
Application.ScreenUpdating = False
Dim i As Long, Cll As Range
With Intersect(ActiveSheet.UsedRange, [A2:B65536]).Offset(, 2)
    .FormulaR1C1 = "=1/RC[-2]"
    .SpecialCells(xlCellTypeFormulas, 16).Offset(, -2).Delete Shift:=xlUp
    .Clear
End With
For i = [B65536].End(xlUp).Row To 2 Step -1
    Set Cll = Range([A1], [A65536].End(xlUp)).Find(What:=Cells(i, 2).Value, After:=[A1], LookIn:=xlFormulas, LookAt:=xlWhole)
    If Not Cll Is Nothing Then
        Cll.Delete Shift:=xlUp
        Cells(i, 2).Delete Shift:=xlUp
    End If
Next
Application.ScreenUpdating = True
End Sub

anhyan130902 · 26/5/11

huuthang_bd đã viết:

Macro của bạn đây

PHP:

Sub GPE()
Application.ScreenUpdating = False
Dim i As Long, Cll As Range
With Intersect(ActiveSheet.UsedRange, [A2:B65536]).Offset(, 2)
.FormulaR1C1 = "=1/RC[-2]"
.SpecialCells(xlCellTypeFormulas, 16).Offset(, -2).Delete Shift:=xlUp
.Clear
End With
For i = [B65536].End(xlUp).Row To 2 Step -1
Set Cll = Range([A1], [A65536].End(xlUp)).Find(What:=Cells(i, 2).Value, After:=[A1], LookIn:=xlFormulas, LookAt:=xlWhole)
If Not Cll Is Nothing Then
Cll.Delete Shift:=xlUp
Cells(i, 2).Delete Shift:=xlUp
End If
Next
Application.ScreenUpdating = True
End Sub

Wow. Tuyệt quá. Thanks bác Thắng nhiều nhiều nhé. Bác Thắng có SĐT thì cho em xin nhé. Nếu bác có địa chỉ tại TPHCm thì tuyệt hơn!

anhyan130902 · 26/5/11

huuthang_bd đã viết:

Macro của bạn đây

PHP:

Sub GPE()
Application.ScreenUpdating = False
Dim i As Long, Cll As Range
With Intersect(ActiveSheet.UsedRange, [A2:B65536]).Offset(, 2)
.FormulaR1C1 = "=1/RC[-2]"
.SpecialCells(xlCellTypeFormulas, 16).Offset(, -2).Delete Shift:=xlUp
.Clear
End With
For i = [B65536].End(xlUp).Row To 2 Step -1
Set Cll = Range([A1], [A65536].End(xlUp)).Find(What:=Cells(i, 2).Value, After:=[A1], LookIn:=xlFormulas, LookAt:=xlWhole)
If Not Cll Is Nothing Then
Cll.Delete Shift:=xlUp
Cells(i, 2).Delete Shift:=xlUp
End If
Next
Application.ScreenUpdating = True
End Sub

Bác Thắng ơi. Em vừa mới mò vào VBA thui. Bác có thể giải thích giúp em theo đoạn mã đươc ko? Năn nỉ bác đó

Giúp em một Macro xoá dòng theo điều kiện.

anhyan130902

Thành viên mới

File đính kèm

huuthang_bd

Chuyên gia GPE

anhyan130902

Thành viên mới

huuthang_bd

Chuyên gia GPE

anhyan130902

Thành viên mới

anhyan130902

Thành viên mới

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian