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

Liên hệ QC
queluatb

queluatb

Thành viên thường trực
Tham gia
17/1/11
Bài viết
345
Được thích
41
- 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
 

File đính kèm

  • DS_duy nhat 2 sheet.xlsm
    34.6 KB · Đọc: 31
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Phải học cú pháp sql này mới được.
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
em cám ơn, nhưng câu lệnh này em hoàn toàn không hiểu gì
 
Upvote 0
Chắc vầy là được rồi:
Name_Unique = DISTINCT(UNION(VALUES('sheet1'[Họ và tên]),VALUES('sheet2'[Họ và tên])))
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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ã:
 
Upvote 0
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ã:
Nhấp chuột vào đây để mở rộng...
em xin cám ơn rất nhiều
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
3 4 5
Trả lời
84
Đọc
2K
ptm0412
ptm0412
Salem999999999
Lọc dữ liệu có điều kiện
2
Trả lời
26
Đọc
666
VetMini
V
P
  • Question
Xin code gán mở theo tài khoản/profie đăng nhập bằng gmail sẵn trên trình duyệt
Trả lời
4
Đọc
208
phantu93
P
V
công thức của nó là gì ạ. mong mọi người giúp
Trả lời
1
Đọc
82
CHAOQUAY
C
son0611excel
  • Question
VBA tra cứu hình theo điều kiện
Trả lời
13
Đọc
313
ongke0711
ongke0711
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom