Dùng VBA lọc, so sánh

[thienthanvuive]

Mình có một danh sách gồm 2 sheet: sheet đầu là danh sách mã và tên nhân viên đã nộp tiền của toàn công ty, sheet thứ 2 là danh sách mã và tên của toàn phòng mình, trong đó có những người đã nộp và những người chưa nộp. Ngoài ra do sự không cẩn thận của người nhập nên trong danh sách ngừoi của phòng mình có nhiều nhân viên bị lặp lại nhiều lần. Mình nhờ các bạn viết macro làm việc sau:
- MACRO1: Kiểm tra xem trong phòng mình những ai có mã nhân viên bị trùng lặp thì xóa hàng bị lặp đi (ví dụ mã M001 có 5 lần trong danh sách thì xóa 4 đi, giữ lại 1).
- MACRO2: Kiểm tra và so sánh nhân viên phòng mình (sheet2) và nhân viên của toàn công ty đã nộp tiền (sheet1), xem ai đã nộp tiền thì ghi vào sheet mới (sheet3). Những người còn lại chưa nộp tiền thì ghi vào sheet mới (sheet4).
- MACRO3: Kiểm tra và so sánh nhân viên phòng mình (sheet2) và nhân viên của toàn công ty đã nộp tiền (sheet1), xem ai đã nộp tiền thì ghi chữ "co", ai chưa nộp tiền ghi chữ "khong" vào cột D của sheet2.

Cảm ơn các bạn nhiều!

 

[Mr Okebab]

Mình có một danh sách gồm 2 sheet: sheet đầu là danh sách mã và tên nhân viên đã nộp tiền của toàn công ty, sheet thứ 2 là danh sách mã và tên của toàn phòng mình, trong đó có những người đã nộp và những người chưa nộp. Ngoài ra do sự không cẩn thận của người nhập nên trong danh sách ngừoi của phòng mình có nhiều nhân viên bị lặp lại nhiều lần. Mình nhờ các bạn viết macro làm việc sau:
- MACRO1: Kiểm tra xem trong phòng mình những ai có mã nhân viên bị trùng lặp thì xóa hàng bị lặp đi (ví dụ mã M001 có 5 lần trong danh sách thì xóa 4 đi, giữ lại 1).
- MACRO2: Kiểm tra và so sánh nhân viên phòng mình (sheet2) và nhân viên của toàn công ty đã nộp tiền (sheet1), xem ai đã nộp tiền thì ghi vào sheet mới (sheet3). Những người còn lại chưa nộp tiền thì ghi vào sheet mới (sheet4).
- MACRO3: Kiểm tra và so sánh nhân viên phòng mình (sheet2) và nhân viên của toàn công ty đã nộp tiền (sheet1), xem ai đã nộp tiền thì ghi chữ "co", ai chưa nộp tiền ghi chữ "khong" vào cột D của sheet2.

Cảm ơn các bạn nhiều!

Bạn xem nhé : (Macro 2 và Macro 3 gộp lại làm 1 bạn ạ)

Option Explicit
Sub Mac01()
    ' Xem co chu nao bi trung lap khong
    Dim i As Long
    With S02
        For i = .Range("B65000").End(xlUp).Row To 2 Step -1
            If WorksheetFunction.CountIf(.Range("B2:B" & i - 1), .Range("B" & i).Value) > 0 Then _
                .Range("B" & i).EntireRow.Delete
        Next
    ' Danh Lai So Thu Tu
        With .Range("A2:A" & .Range("B65000").End(xlUp).Row)
            .Formula = "=Row()-1"
            .Calculate
            .Value = .Value
        End With
    End With
 
End Sub

Sub Mac02()
    ' Xem co chu nao choi xau khong ??
    Dim i As Long, HC As Long, HCi As Long, MaNV As String
    ' Xoa truoc da
    S03.Range("A2:D10000").ClearContents
    S04.Range("A2:D10000").ClearContents
    HC = S01.Range("B65000").End(xlUp).Row
    
    With S02
        For i = 2 To .Range("B65000").End(xlUp).Row
            MaNV = .Range("B" & i).Value
            ' Xem nop hay chua nop
            If WorksheetFunction.CountIf(S01.Range("B2:B" & HC), MaNV) > 0 Then
                ' Da Nop
                .Range("D" & i).Value = "Da Nop"
                HCi = S03.Range("B65000").End(xlUp).Row + 1
                S03.Range("B" & HCi & ":C" & HCi).Value = .Range("B" & i & ":C" & i).Value
            Else
                ' Chu nay Chua Nop
                .Range("D" & i).Value = "Chua Nop"
                HCi = S04.Range("B65000").End(xlUp).Row + 1
                S04.Range("B" & HCi & ":C" & HCi).Value = .Range("B" & i & ":C" & i).Value
            End If
        Next
    ' Danh Lai So Thu Tu
    End With
    With S03.Range("A2:A" & S03.Range("B65000").End(xlUp).Row)
        .Formula = "=Row()-1"
        .Calculate
        .Value = .Value
    End With
    With S04.Range("A2:A" & S04.Range("B65000").End(xlUp).Row)
        .Formula = "=Row()-1"
        .Calculate
        .Value = .Value
    End With

End Sub

Chỉ là VD để bạn tham khảo.
Thân!

 

[thienthanvuive]

Bạn xem nhé : (Macro 2 và Macro 3 gộp lại làm 1 bạn ạ)

Sub Mac02()
    ' Xem co chu nao choi xau khong ??
    Dim i As Long, HC As Long, HCi As Long, MaNV As String
    ' Xoa truoc da
    S03.Range("A2:D10000").ClearContents
    S04.Range("A2:D10000").ClearContents
    HC = S01.Range("B65000").End(xlUp).Row
    
    With S02
        For i = 2 To .Range("B65000").End(xlUp).Row
            MaNV = .Range("B" & i).Value
            ' Xem nop hay chua nop
            If WorksheetFunction.CountIf(S01.Range("B2:B" & HC), MaNV) > 0 Then
                ' Da Nop
                .Range("D" & i).Value = "Da Nop"
                HCi = S03.Range("B65000").End(xlUp).Row + 1
                S03.Range("B" & HCi & ":C" & HCi).Value = .Range("B" & i & ":C" & i).Value
            Else
                ' Chu nay Chua Nop
                .Range("D" & i).Value = "Chua Nop"
                HCi = S04.Range("B65000").End(xlUp).Row + 1
                S04.Range("B" & HCi & ":C" & HCi).Value = .Range("B" & i & ":C" & i).Value
            End If
        Next
    ' Danh Lai So Thu Tu
    End With
    With S03.Range("A2:A" & S03.Range("B65000").End(xlUp).Row)
        .Formula = "=Row()-1"
        .Calculate
        .Value = .Value
    End With
    With S04.Range("A2:A" & S04.Range("B65000").End(xlUp).Row)
        .Formula = "=Row()-1"
        .Calculate
        .Value = .Value
    End With

End Sub

Mình muốn trong đoạn macro này thêm một lệnh tạo sheet mới và đặt tên cho sheet mới này thì làm thế nào?

 

[Mr Okebab]

Function WksExists(wksName As String) As Boolean
'How can I tell if a specific worksheet exists?
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

Mình muốn trong đoạn macro này thêm một lệnh tạo sheet mới và đặt tên cho sheet mới này thì làm thế nào?

Trước khi tạo ra 1 sheet mới thì phải kiểm tra xem sheet đó đã tồn tại chưa ???

Function WksExists(wksName As String) As Boolean

    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

Nếu chưa có thì tạo Sh mới : VD : Tên Sheet là ABC

If WksExists("ABC") = False Then Sheets.Add.Name = "ABC"

Thân!

 

[tigertiger]

Nếu chưa có thì tạo Sh mới : VD : Tên Sheet là ABC

PHP Code:

If WksExists("ABC") = False Then Sheets.Add.Name = "ABC"
​

Thân!

hình như nhầm
Chính xác thế này chứ

 If SheetExists("ABC") = False Then Sheets.Add.Name = "ABC"

 

[voda]

If SheetExists("ABC") = False Then Sheets.Add.Name = "ABC"

hình như nhầm
Chính xác thế này chứ

If WksExists("ABC") = False Then Sheets.Add.Name = "ABC"

 

[msc0506]

Trươc mình có làm cách nay nhưng thấy báo lỗi và sẽ tạo thêm 1 sheet mới nên mình làm cách này , Bạn nào có giải pháp hay hơn thì chia sẻ cho mình nhé
Code :
If SheetCT.cells(1,10)="" Then
SheetCT.cells(1,10)="1"
' Code cua ban o day

else : Exit sub : End if


Hơi chuối nhưng Không còn lỗi và ko cần thêm 1 hàm nữa

Các bạn có giải pháp nào hay hơn thì chia sẻ cho mình và các bạn khác nhé