Chương trình so sánh 2 file Excel

  • Thread starter Thread starter hkthuy
  • Ngày gửi Ngày gửi
Liên hệ QC
H

hkthuy

Thành viên mới
Tham gia
22/5/10
Bài viết
16
Được thích
0
Chào mọi người. M đang cần sự giúp đỡ để giải quyết 1 bài tập khó. Hi vọng sẽ nhận được những lời giải đáp của các bạn.
Nội dung như sau:
Cho 2 file Excel thống kê số hàng bán trong 1 ngày của 1 cửa hàng.(do 1 nhân viên đứng bán và 1 nhân viên thu ngân thống kê) gồm các cột: Mã hàng, tên hàng, tổng giá.
Yêu cầu.
1/Xuất ra những mặt hàng mà MaHang file 1 có, file 2 không có.
2/Xuất ra những mặt hàng mà MaHang file 2 có, file 1 không có.
3/Xuất ra những mặt hàng mà MaHang file 1 & 2 đều có và TongGia giống nhau.
4/Xuất ra những mặt hàng mà MaHang file 1 & 2 đều có và TongGia khác nhau.
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
hkthuy đã viết:
Đó chỉ là dữ liệu test. A có thể thêm vào tùy ý. Em đang cần sự giúp đỡ của cộng đồng GPE!^^
Nhấp chuột vào đây để mở rộng...
Không biết với 1 code có sẳn, bạn có thể tự mình tùy biến lấy không nhỉ?
Code kiểu này tôi viết cũng khá lâu rồi, giờ gữi file lên cho bạn tham khảo
PHP: 
Sub Main()
  Dim Dic1, Dic2, Src, Item
  Dim Arr1(1 To 65535, 1 To 1)
  Dim Arr2(1 To 65535, 1 To 1)
  Dim Arr3(1 To 65535, 1 To 1)
  Dim i As Long, j1 As Long, j2 As Long, j3 As Long
  Dim TG As Double
  TG = Timer
  Src = Range("A2:B65536").Value
  Set Dic1 = CreateObject("Scripting.Dictionary")
  Set Dic2 = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(Src)
    If Not Dic1.Exists(Src(i, 1)) And Src(i, 1) <> "" Then
      Dic1.Add Src(i, 1), ""
    End If
  Next
  For i = 1 To UBound(Src)
    If Not Dic2.Exists(Src(i, 2)) And Src(i, 2) <> "" Then
      Dic2.Add Src(i, 2), ""
      If Dic1.Exists(Src(i, 2)) Then
        j1 = j1 + 1
        Arr1(j1, 1) = Src(i, 2)
      Else
        j3 = j3 + 1
        Arr3(j3, 1) = Src(i, 2)
      End If
    End If
  Next
  For Each Item In Dic1.Keys
    If Not Dic2.Exists(Item) Then
      j2 = j2 + 1
      Arr2(j2, 1) = Item
    End If
  Next
  Range("D2").Resize(j1).Value = Arr1
  Range("E2").Resize(j2).Value = Arr2
  Range("F2").Resize(j3).Value = Arr3
  MsgBox Format(Timer - TG, "0.000000000")
End Sub
Code này so sánh 2 list có trong cột A và B rồi xuất kết quả sang cột D, E, F
Dữ liệu 15000 dòng trong mổi list, code chạy mất 0.5s
Cố gắng nghiên cứu và "áp" vào file của mình nhé
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Trong file gửi GPE. Em cần so sánh 2 cột MaHang và cột TongGia. Chương trình của anh rất hay nhưng với vốn kiến thức ít ỏi về excel của em, em chưa thể tự biên tự diễn được. ^^ Rất mong mọi người giúp đỡ. Em thấy bài của HaiYen17 đã đúng được 3/4 yêu cầu rồi. Còn cái khó nhất thì vẫn đang còn đó. Hichic
 
Upvote 0
hkthuy đã viết:
Trong file gửi GPE. Em cần so sánh 2 cột MaHang và cột TongGia. Chương trình của anh rất hay nhưng với vốn kiến thức ít ỏi về excel của em, em chưa thể tự biên tự diễn được. ^^ Rất mong mọi người giúp đỡ. Em thấy bài của HaiYen17 đã đúng được 3/4 yêu cầu rồi. Còn cái khó nhất thì vẫn đang còn đó. Hichic
Nhấp chuột vào đây để mở rộng...
Không biết dữ liệu thật của bạn có nhiều không? Nếu cở khoảng vài ngàn dòng trở lên thì đương nhiên phải dùng đến code rồi ---> Mà nói thật, cái đã viết xong giờ phải viết lại cho phù hợp với yêu cầu của bạn thì... hơi lười chút (đang bệnh, để ngày mai xem sao)
Còn nếu dữ liệu của bạn chỉ vài trăm dòng thì có 1 cách chẳng cần dùng đến công thức hay code gì ráo: Advanced Filter
 
Upvote 0
Đúng là dữ liệu của bạn còn có những vấn đề fải bàn

Nhưng thấy bạn cần gấp, nên đưa lên fân nữa iêu cầu, Nữa còn lại cũng do chưa rõ & cần bạn giải thích thêm

Trong file đính kèm của bạn, nếu không sửa dữ liệu tại 2 trang tính đầu, thì macro có viết đúng cũng sẽ không tìm ra dữ liệu nào thỏa để hầu lắp vô trang 3 & 4; Do bạn không có dữ liệu nào khác nhau giữa 1 & 2. Bạn chú ý lần sau khi đưa dữ liệu lên fải có tính tổng quát, bao hàm hết mọi trường hợp thì đỡ tốn bao nhiêu thời gian của cộng đồng thân iêu này!

Vấn đề nữa, đó là để hoàn thành tiếp fần còn lại của iêu cầu, xin đề nghị bạn cho biếtcách xử trí vấn đề sau:

Ở [CTi_A] có mã hàng ...47 với tổng giá là x9000; Còn trang tính [CTi_B] có 2 dòng chứa mã hàng này với tổng giá khác nhau;
Vậy vấn đề là có chép chúng hay không? & chép thì chép vô đâu vậy? [GiongGia] hay [KhacGia]
 

File đính kèm

Upvote 0
Mình gửi lại file dữ liệu test. Rất mong mọi người giúp mình. Mình nói qua về một chút.
1. Về dữ liệu: có thể >2,000
2. Yêu cầu
- Trong sheet MaCTiA: Hiện những Mã hàng mà tồn tại trong báo cáo CTY A nhưng không tồn tại trong báo cáo CTY B
- Trong sheet MaCTiB: Hiện những Mã hàng mà tồn tại trong báo cáo CTY B nhưng không tồn tại trong báo cáo CTY A
- Trong sheet GiongNhau: Hiện những Mã hàng & Tổng giá giống nhau trong hai báo cáo
- Trong sheet KhacNhau: Hiện những Mã hàng giống nhau nhưng có sự khác nhau về tổng giá. Khi đó, trên cùng một hàng, dữ liệu hai báo cáo sẽ lần lượt được thể hiện với format sau:
STT___Mã Hàng ___Tổng giá CTY A___Tổng giá CTY B___Mã SP CTY A___Mã SP CTY B___Tên NSX CTY A___Tên NSX CTY B
Đây là dữ liệu kèm theo. Mọi người gắng dành chút thời gian cho sự giúp đỡ mình nhé. Cảm ơn GPE nhiều.
 

File đính kèm

Upvote 0
ChanhTQ@ đã viết:
Ở [CTi_A] có mã hàng ...47 với tổng giá là x9000; Còn trang tính [CTi_B] có 2 dòng chứa mã hàng này với tổng giá khác nhau;
Vậy vấn đề là có chép chúng hay không? & chép thì chép vô đâu vậy? [GiongGia] hay [KhacGia]
Nhấp chuột vào đây để mở rộng...
Đó là lỗi copy dữ liệu. Bạn thông cảm giúp mình
 
Upvote 0
Hãy chỉnh sửa cấu trúc tại [KhacGia] chút, như sau & chạy macro

Bạn tô chọn 'B2:E2' của [CTi_A] chép tới b2 của trang này & tô 4 ô mới chép đến 1 màu nền nhạt nào đó (như xanh da trời)
& chép 4 ô có địa chỉ như vậy ở trang CTi_B đến [F2] của trang tính này & thực hiện tô màu nền 4 ô vừa chép tới tức thì màu khác màu trên;

Chép đè toàn bô macro này lên nội dung macro cũ & bấm tổ hợp 3 fím tắt ta đã gán để macro cung cấp cho bạn hoàn chỉnh dữ liệu vô 4 trang tính.

PHP: 
Option Explicit

Sub SoSanh2TrangTinh()
 Dim ShName As String, sName As String, MyAdd As String
 ReDim eRw(1 To 2) As Long
 Dim Jj As Byte
 Dim Cls As Range, Rng As Range, sRng As Range
 Dim Sh As Worksheet, Sh0 As Worksheet, Sht As Worksheet, ShG As Worksheet, ShK As Worksheet
 
 For Jj = 65 To 66
   Sheets("MaCTi" & Chr(Jj)).[B2].CurrentRegion.Offset(2, 1).ClearContents
 Next Jj
 Set ShG = Sheets("GiongGia"):                        Set ShK = Sheets("KhacGia")
 ShG.[B2].CurrentRegion.Offset(2, 1).ClearContents
 ShK.[B2].CurrentRegion.Offset(2, 1).ClearContents
 For Jj = 1 To 2
   Set Sht = Sheets("CTi_" & Chr(64 + Jj))
   
   ShName = "CTi_" & Choose(Jj, "B", "A"):            Set Sh = Sheets(ShName)
   sName = "MaCTi" & Chr(Jj + 64):                    Set Sh0 = Sheets(sName)
   
   Set Rng = Sh.Range(Sh.[B2], Sh.[B65500].End(xlUp))
   For Each Cls In Sht.Range(Sht.[B3], Sht.[B65500].End(xlUp))
      Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
      If sRng Is Nothing Then
         With Sh0.[B65500].End(xlUp).Offset(1)
            .Resize(, 4).Value = Cls.Resize(, 4).Value
         End With
      Else
         MyAdd = sRng.Address
         Do
            If Cls.Offset(, 1).Value = sRng.Offset(, 1).Value Then
               With ShG.[B65500].End(xlUp).Offset(1)
                  .Resize(, 4).Value = Cls.Resize(, 4).Value
               End With
            Else
               With ShK.[B65500].End(xlUp).Offset(1)
                  .Resize(, 4).Value = Cls.Resize(, 4).Value
                  .Offset(, 4).Resize(, 4).Value = sRng.Resize(, 4).Value
               End With
            End If
            Set sRng = Rng.FindNext(sRng)
         Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
      End If
   Next Cls
 Next Jj
End Sub
(Định dạng lại các ô nếu cần)
 
Upvote 0
Cảm ơn về sự giúp đỡ của GPE. Trong bài của HYen17,mình đã test và xảy ra một số vấn đề. Trong số liệu trong đó, kết quả bị sau nhiều. Cụ thể như sau:
- Trong sheet GiongNhau, KhacNhau. tât cả MaHang lặp lại 2 lần dẫn đến việc
+ Tổng số của sheet CTiA = 150 nhưng tổng các sheet liên quan là 196 (Sheet MaCTiA= 104 + GiongNhau = 70 + KhacNhau = 22)
+ Tổng số của sheet CTiB = 60 nhưng tổng các sheet liên quan là 106 (sheet MaCTiB = 14 + GiongNhau = 70 + KhacNhau = 22)
Nếu kết quả của GiongNhau và KhacNhau không bị lặp thì bài toán sẽ đúng hoàn toàn. Mình chưa sửa được macro trong đó. Mọi người giúp đỡ mình
Cảm ơn GPE.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Sai với hướng dẫn của bạn hay sai với ý tưởng của bạn?

Đâu, bạn chọn 3 dòng lệnh đã đánh số chép vô thêm macro sẵn có & chạy; Sau đó tự kiểm tra xem sao nha. Hãy đưa lên kết luận của bạn sau khi kiểm kỹ lưỡng

PHP: 
Option Explicit
Sub SoSanh2TrangTinh()
 Dim ShName As String, sName As String, MyAdd As String
 ReDim eRw(1 To 2) As Long
 Dim Jj As Byte
 Dim Cls As Range, Rng As Range, sRng As Range
 Dim Sh As Worksheet, Sh0 As Worksheet, Sht As Worksheet, ShG As Worksheet, ShK As Worksheet
 
 For Jj = 65 To 66
   Sheets("MaCTi" & Chr(Jj)).[B2].CurrentRegion.Offset(2, 1).ClearContents
 Next Jj
 Set ShG = Sheets("GiongGia"):                        Set ShK = Sheets("KhacGia")
 ShG.[B2].CurrentRegion.Offset(2, 1).ClearContents
 ShK.[B2].CurrentRegion.Offset(2, 1).ClearContents
 For Jj = 1 To 2
   Set Sht = Sheets("CTi_" & Chr(64 + Jj))
   
   ShName = "CTi_" & Choose(Jj, "B", "A"):            Set Sh = Sheets(ShName)
   sName = "MaCTi" & Chr(Jj + 64):                    Set Sh0 = Sheets(sName)
   
   Set Rng = Sh.Range(Sh.[B2], Sh.[B65500].End(xlUp))
   For Each Cls In Sht.Range(Sht.[B3], Sht.[B65500].End(xlUp))
      Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
      If sRng Is Nothing Then
         With Sh0.[B65500].End(xlUp).Offset(1)
            .Resize(, 4).Value = Cls.Resize(, 4).Value
         End With
1         Cells(Cls.Row, 1).Interior.ColorIndex = 38     '<=|'
      Else
         MyAdd = sRng.Address
         Do
            If Cls.Offset(, 1).Value = sRng.Offset(, 1).Value Then
2               Cls.Interior.ColorIndex = 39           '<=|'
               With ShG.[B65500].End(xlUp).Offset(1)
                  .Resize(, 4).Value = Cls.Resize(, 4).Value
               End With
            Else
3               Cls.Interior.ColorIndex = 37           '<=|'
               With ShK.[B65500].End(xlUp).Offset(1)
                  .Resize(, 4).Value = Cls.Resize(, 4).Value
                  .Offset(, 4).Resize(, 4).Value = sRng.Resize(, 4).Value
               End With
            End If
            Set sRng = Rng.FindNext(sRng)
         Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
      End If
   Next Cls
 Next Jj
End Sub
 
Upvote 0
ChanhTQ@ đã viết:
Đâu, bạn chọn 3 dòng lệnh đã đánh số chép vô thêm macro sẵn có & chạy; Sau đó tự kiểm tra xem sao nha. Hãy đưa lên kết luận của bạn sau khi kiểm kỹ lưỡng

PHP: 
Option Explicit
Sub SoSanh2TrangTinh()
 Dim ShName As String, sName As String, MyAdd As String
 ReDim eRw(1 To 2) As Long
 Dim Jj As Byte
 Dim Cls As Range, Rng As Range, sRng As Range
 Dim Sh As Worksheet, Sh0 As Worksheet, Sht As Worksheet, ShG As Worksheet, ShK As Worksheet
 
 For Jj = 65 To 66
   Sheets("MaCTi" & Chr(Jj)).[B2].CurrentRegion.Offset(2, 1).ClearContents
 Next Jj
 Set ShG = Sheets("GiongGia"):                        Set ShK = Sheets("KhacGia")
 ShG.[B2].CurrentRegion.Offset(2, 1).ClearContents
 ShK.[B2].CurrentRegion.Offset(2, 1).ClearContents
 For Jj = 1 To 2
   Set Sht = Sheets("CTi_" & Chr(64 + Jj))
   
   ShName = "CTi_" & Choose(Jj, "B", "A"):            Set Sh = Sheets(ShName)
   sName = "MaCTi" & Chr(Jj + 64):                    Set Sh0 = Sheets(sName)
   
   Set Rng = Sh.Range(Sh.[B2], Sh.[B65500].End(xlUp))
   For Each Cls In Sht.Range(Sht.[B3], Sht.[B65500].End(xlUp))
      Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
      If sRng Is Nothing Then
         With Sh0.[B65500].End(xlUp).Offset(1)
            .Resize(, 4).Value = Cls.Resize(, 4).Value
         End With
1         Cells(Cls.Row, 1).Interior.ColorIndex = 38     '<=|'
      Else
         MyAdd = sRng.Address
         Do
            If Cls.Offset(, 1).Value = sRng.Offset(, 1).Value Then
2               Cls.Interior.ColorIndex = 39           '<=|'
               With ShG.[B65500].End(xlUp).Offset(1)
                  .Resize(, 4).Value = Cls.Resize(, 4).Value
               End With
            Else
3               Cls.Interior.ColorIndex = 37           '<=|'
               With ShK.[B65500].End(xlUp).Offset(1)
                  .Resize(, 4).Value = Cls.Resize(, 4).Value
                  .Offset(, 4).Resize(, 4).Value = sRng.Resize(, 4).Value
               End With
            End If
            Set sRng = Rng.FindNext(sRng)
         Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
      End If
   Next Cls
 Next Jj
End Sub
Nhấp chuột vào đây để mở rộng...

Sai kết quả. Mình đã nói rõ là sai ở đâu rồi đó. Kết quả xuất ra bị lặp lại hai lần ở sheet KhacNhau và GiongNhau. Bạn hãy cộng lại STT cuối cùng của từng sheet liên quan để kiểm tra lại
 
Upvote 0
Thì bỏ bớt 1 lần ghi đi vậy, chắc sẽ OK!

PHP: 
Option Explicit
Sub SoSanh2TrangTinh()
 Dim ShName As String, sName As String, MyAdd As String
 ReDim eRw(1 To 2) As Long
 Dim jJ As Byte
 Dim Cls As Range, Rng As Range, sRng As Range
 Dim Sh As Worksheet, Sh0 As Worksheet, Sht As Worksheet, ShG As Worksheet, ShK As Worksheet
 
 For jJ = 65 To 66
   Sheets("MaCTi" & Chr(jJ)).[B2].CurrentRegion.Offset(2, 1).ClearContents
 Next jJ
 Set ShG = Sheets("GiongGia"):                        Set ShK = Sheets("KhacGia")
 ShG.[B2].CurrentRegion.Offset(2, 1).ClearContents
 ShK.[B2].CurrentRegion.Offset(2, 1).ClearContents
 For jJ = 1 To 2
   Set Sht = Sheets("CTi_" & Chr(64 + jJ))
   
   ShName = "CTi_" & Choose(jJ, "B", "A"):            Set Sh = Sheets(ShName)
   sName = "MaCTi" & Chr(jJ + 64):                    Set Sh0 = Sheets(sName)
   
   Set Rng = Sh.Range(Sh.[B2], Sh.[B65500].End(xlUp))
   For Each Cls In Sht.Range(Sht.[B3], Sht.[B65500].End(xlUp))
      Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
      If sRng Is Nothing Then
         With Sh0.[B65500].End(xlUp).Offset(1)
            .Resize(, 4).Value = Cls.Resize(, 4).Value
         End With
      Else
         If jJ = 1 Then                               '<=|'
            MyAdd = sRng.Address
            Do
               If Cls.Offset(, 1).Value = sRng.Offset(, 1).Value Then
                  With ShG.[B65500].End(xlUp).Offset(1)
                     .Resize(, 4).Value = Cls.Resize(, 4).Value
                  End With
               Else
                  With ShK.[B65500].End(xlUp).Offset(1)
                     .Resize(, 4).Value = Cls.Resize(, 4).Value
                     .Offset(, 4).Resize(, 4).Value = sRng.Resize(, 4).Value
                  End With
               End If
               Set sRng = Rng.FindNext(sRng)
            Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
         End If                                       '<=|'
      End If
   Next Cls
 Next jJ
End Sub
 
Upvote 0
cảm ơn GPE rất nhiều. Chúc cho GPE ngày càng phát triển và luôn có những bài viết chất lượng
 
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

C
Trách nhiệm pháp lý của chi nhánh doanh nghiệp Việt Nam tại nước ngoài với Công ty tại Việt Nam
Trả lời
4
Đọc
122
cuongtri
C
GPE-Trợ Lý
[GPE] TALK SHOW HÀM QUERY - BÍ KÍP BIẾN DỮ LIỆU KHỔNG LỒ THÀNH THÔNG TIN HỮU ÍCH TRONG TÍCH TẮC
    • Thích
    • Yêu thích
Trả lời
5
Đọc
2K
Ha Manh-LD
Ha Manh-LD
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2 3
Trả lời
45
Đọc
14K
ngocthu90
ngocthu90
Uyên dương Hoya
Lỗi định dạng font chữ trong excel
Trả lời
3
Đọc
107
ptm0412
ptm0412
mucongnghenhat
lỗi đoạn văn bản bị đóng khung
Trả lời
1
Đọc
62
vietduc147258
V
T
  • Question Question
Xin code VBA trả về tên tài khoản theo điều kiện
    • Chấp nhận
Trả lời
12
Đọc
434
VetMini
V
HeSanbi
  • Question Question
VBA Nâng cao: Hướng dẫn tạo biểu thức tìm kiếm với Regular Expression
    • Thích
    • Yêu thích
Trả lời
8
Đọc
644
nguyendang95
N
ntnguyentam1907
Lấy bảng dữ liệu chứng khoán về excel
2
Trả lời
22
Đọc
3K
nguyendang95
N
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Thích
    • Cảm ơn
Trả lời
5
Đọc
765
hoangtuan.net
hoangtuan.net
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
305
Đọc
22K
pkt.bacdau
pkt.bacdau
HONGVY91
Đếm số lượng 2 cột và đếm không trùng
Trả lời
2
Đọc
130
hoangtuaotrang_hp_vn
H
hanhlx88
Nhờ giúp file Excel báo lỗi: Excel cannot complete this task with available resources
Trả lời
3
Đọc
189
hanhlx88
hanhlx88
HeSanbi
  • Đã giải quyết
LocalizeXL v1.73 - Làm nổi bật ô đang chọn và cuộn trang tự động
    • Thích
    • Yêu thích
2 3 4
Trả lời
73
Đọc
10K
HeSanbi
HeSanbi
L
Folder chứa chương trình bị khóa bởi Lock folder
2
Trả lời
28
Đọc
25K
qthangvphaui
Q
P
Xin trợ giúp cách lập lịch trực tịnh tiến dần cho 1 nhóm người.
Trả lời
4
Đọc
148
phambahoang
P
N
Tính tổng với điều kiện gần đúng
Trả lời
3
Đọc
75
HUONGHCKT
H
Bùi Thúy Thúy
  • Question Question
Lấy dữ liệu thời tiết Accuweather để điền vào nhật ký thi công
2 3 4
Trả lời
63
Đọc
19K
Mutants Men
M
Anxseo
  • Đã khóa
Cách crack my excel
Trả lời
1
Đọc
198
HeSanbi
HeSanbi
phatnguyen7301
  • Question Question
Tạo âm thanh khi nhấn vào một phím
Trả lời
5
Đọc
249
yaaasoo01
Y
anhtuan1066
  • Question Question
Chèn hình vào cell bằng hàm tự tạo
    • Thích
    • Ngạc nhiên
10 11 12
Trả lời
235
Đọc
106K
XaNguyen
X
Xem thêm…

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

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới.
Back
Top Bottom