Lọc danh sách duy nhất từ 2 sheet

queluatb · 7/9/21

- Em mới học và tìm hiểu về code VBA, trong file em đã ra được kết quả như mong muốn
+ Trong file e có danh sách người lao động từ 2 sheet, em muốn lọc ra danh sách duy nhất từ hai sheet và kiểm tra sự thay đổi về giá trị giữa hai sheet, đồng thời xem sheet nào có người nào và sheet nào thiếu người nào
- Em xin nhờ các thầy, anh, chị xem giúp em code trong file đính kèm phần nào được, chưa được, và lên làm thế nào để tối ưu hơn được code
Em xin cám ơn

Hai Lúa Miền Tây · 7/9/21

queluatb đã viết:
- Em mới học và tìm hiểu về code VBA, trong file em đã ra được kết quả như mong muốn
+ Trong file e có danh sách người lao động từ 2 sheet, em muốn lọc ra danh sách duy nhất từ hai sheet và kiểm tra sự thay đổi về giá trị giữa hai sheet, đồng thời xem sheet nào có người nào và sheet nào thiếu người nào
- Em xin nhờ các thầy, anh, chị xem giúp em code trong file đính kèm phần nào được, chưa được, và lên làm thế nào để tối ưu hơn được code
Em xin cám ơn

Bạn thử code sau nhé:

Mã:

Sub KiemTra_HLMT()
    Dim strSQL As String
    strSQL = "Select F1,F2,0 as Luong From [Sheet1$A2:B] Where F2 Is Not Null Union All Select F1,0,F2 From [Sheet2$A2:B] Where F2 Is Not Null"
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"""
        Sheet1.Range("M2").CopyFromRecordset .Execute("Select F1, Sum(F2), Sum(Luong),Sum(F2)-Sum(Luong) From(" & strSQL & ") Group By F1")
    End With
End Sub

Maika8008 · 7/9/21

Hai Lúa Miền Tây đã viết:

Bạn thử code sau nhé:

Mã:

Sub KiemTra_HLMT()
    Dim strSQL As String
    strSQL = "Select F1,F2,0 as Luong From [Sheet1$A2:B] Where F2 Is Not Null Union All Select F1,0,F2 From [Sheet2$A2:B] Where F2 Is Not Null"
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"""
        Sheet1.Range("M2").CopyFromRecordset .Execute("Select F1, Sum(F2), Sum(Luong),Sum(F2)-Sum(Luong) From(" & strSQL & ") Group By F1")
    End With
End Sub

Phải học cú pháp sql này mới được.

queluatb · 7/9/21

Hai Lúa Miền Tây đã viết:

Bạn thử code sau nhé:

Mã:

Sub KiemTra_HLMT()
    Dim strSQL As String
    strSQL = "Select F1,F2,0 as Luong From [Sheet1$A2:B] Where F2 Is Not Null Union All Select F1,0,F2 From [Sheet2$A2:B] Where F2 Is Not Null"
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"""
        Sheet1.Range("M2").CopyFromRecordset .Execute("Select F1, Sum(F2), Sum(Luong),Sum(F2)-Sum(Luong) From(" & strSQL & ") Group By F1")
    End With
End Sub

em cám ơn, nhưng câu lệnh này em hoàn toàn không hiểu gì

Hai Lúa Miền Tây · 7/9/21

queluatb đã viết:
em cám ơn, nhưng câu lệnh này em hoàn toàn không hiểu gì

Nhưng kết quả thì sao bạn?

queluatb · 7/9/21

Hai Lúa Miền Tây đã viết:
Nhưng kết quả thì sao bạn?

Nhanh và chính xác ạ

tranhungdao12a3 · 7/9/21

Chắc vầy là được rồi:
Name_Unique = DISTINCT(UNION(VALUES('sheet1'[Họ và tên]),VALUES('sheet2'[Họ và tên])))

Ba Tê · 7/9/21

queluatb đã viết:
- Em mới học và tìm hiểu về code VBA, trong file em đã ra được kết quả như mong muốn
+ Trong file e có danh sách người lao động từ 2 sheet, em muốn lọc ra danh sách duy nhất từ hai sheet và kiểm tra sự thay đổi về giá trị giữa hai sheet, đồng thời xem sheet nào có người nào và sheet nào thiếu người nào
- Em xin nhờ các thầy, anh, chị xem giúp em code trong file đính kèm phần nào được, chưa được, và lên làm thế nào để tối ưu hơn được code
Em xin cám ơn

Rút gọn lại một chút như vầy:

PHP:

Option Explicit
Sub DictionaryFilter()
Dim Dic As Object, Arr1(), Arr2(), Result()
Dim i As Long, k As Long, R As Long, Rws As Long, sKey As String
Set Dic = CreateObject("Scripting.Dictionary")
    Arr2 = Sheet2.Range("A2", Sheet2.Range("A100000").End(xlUp)).Resize(, 2).Value
With Sheet1
    Arr1 = .Range("A2", .Range("A100000").End(xlUp)).Resize(, 2).Value
    Rws = UBound(Arr1)
    ReDim Result(1 To Rws + UBound(Arr2), 1 To 5)
    For i = 1 To Rws
        If Arr1(i, 1) <> Empty Then
            sKey = Arr1(i, 1)
            If Not Dic.Exists(sKey) Then
                k = k + 1
                Dic.Add sKey, k
                Result(k, 1) = k
                Result(k, 2) = sKey
                Result(k, 3) = Arr1(i, 2)
                Result(k, 5) = Arr1(i, 2)
            End If
        End If
    Next i
    '========================================='
    Rws = UBound(Arr2)
    For i = 1 To Rws
        If Arr2(i, 1) <> Empty Then
            sKey = Arr2(i, 1)
            If Not Dic.Exists(sKey) Then
                k = k + 1
                Dic.Add sKey, k
                Result(k, 1) = k
                Result(k, 2) = sKey
                Result(k, 4) = Round(Arr2(i, 2), 0)
                Result(k, 5) = Result(k, 4)
            Else
                R = Dic.Item(sKey)
                Result(R, 4) = Round(Arr2(i, 2), 0)
                Result(R, 5) = Result(R, 3) - Result(R, 4)
            End If
        End If
    Next i
    .Range("E2").Resize(100000, 5).ClearContents
    .Range("E2").Resize(k, 5) = Result
End With
Set Dic = Nothing
End Sub

Mã:

queluatb · 7/9/21

Ba Tê đã viết:

Rút gọn lại một chút như vầy:

PHP:

Option Explicit
Sub DictionaryFilter()
Dim Dic As Object, Arr1(), Arr2(), Result()
Dim i As Long, k As Long, R As Long, Rws As Long, sKey As String
Set Dic = CreateObject("Scripting.Dictionary")
    Arr2 = Sheet2.Range("A2", Sheet2.Range("A100000").End(xlUp)).Resize(, 2).Value
With Sheet1
    Arr1 = .Range("A2", .Range("A100000").End(xlUp)).Resize(, 2).Value
    Rws = UBound(Arr1)
    ReDim Result(1 To Rws + UBound(Arr2), 1 To 5)
    For i = 1 To Rws
        If Arr1(i, 1) <> Empty Then
            sKey = Arr1(i, 1)
            If Not Dic.Exists(sKey) Then
                k = k + 1
                Dic.Add sKey, k
                Result(k, 1) = k
                Result(k, 2) = sKey
                Result(k, 3) = Arr1(i, 2)
                Result(k, 5) = Arr1(i, 2)
            End If
        End If
    Next i
    '========================================='
    Rws = UBound(Arr2)
    For i = 1 To Rws
        If Arr2(i, 1) <> Empty Then
            sKey = Arr2(i, 1)
            If Not Dic.Exists(sKey) Then
                k = k + 1
                Dic.Add sKey, k
                Result(k, 1) = k
                Result(k, 2) = sKey
                Result(k, 4) = Round(Arr2(i, 2), 0)
                Result(k, 5) = Result(k, 4)
            Else
                R = Dic.Item(sKey)
                Result(R, 4) = Round(Arr2(i, 2), 0)
                Result(R, 5) = Result(R, 3) - Result(R, 4)
            End If
        End If
    Next i
    .Range("E2").Resize(100000, 5).ClearContents
    .Range("E2").Resize(k, 5) = Result
End With
Set Dic = Nothing
End Sub

Mã:

em xin cám ơn rất nhiều

Lọc danh sách duy nhất từ 2 sheet

queluatb

Thành viên thường trực

File đính kèm

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆

Maika8008

Thành viên gạo cội

queluatb

Thành viên thường trực

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆

queluatb

Thành viên thường trực

tranhungdao12a3

Thành viên tiêu biểu

Ba Tê

Cạo Rồi Khỏi Gội

queluatb

Thành viên thường trực

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