Chương trình so sánh 2 file Excel (1 người xem)

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

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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
Để nhận được sự giúp đỡ nhiệt tình của các thành viên bạn hãy gửi file mẫu lên, kèm theo việc diễn giải chi tiết các yêu cầu của bài toán, nếu cần thiết bạn lấy cả ví dụ cụ thể về số liệu mong muốn có được bằng cách gõ trực tiếp vào file mẫu.
 
Upvote 0
Đây là file đính kèm(Số liệu thử). Các bạn giúp mình.
Cảm ơn
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Cặp macro của bạn đây

PHP: 
Option Explicit
Dim ShN As Worksheet, ShD As Worksheet
Dim Rng As Range, sRng As Range, Rng0 As Range

Sub HaiTrong1()
 Dim Lech As Byte, Cls As Range
 
 Lech = InputBox("Hay Chon Fuong Án", "1 - Lech 1", "1")
 If Lech = 1 Then
   Set ShN = Sheets("WToE"):        Set ShD = Sheets("PToE")
   Set Rng0 = ShN.Range(ShN.[c3], ShN.[c65500].End(xlUp))
   Set Rng = ShD.Range(ShD.[c2], ShD.[c65500].End(xlUp))
   Sheets("Lech1").Select
 ElseIf Lech = 2 Then
   Set ShD = Sheets("WToE"):        Set ShN = Sheets("PToE")
   Set Rng0 = ShN.Range(ShN.[c3], ShN.[c65500].End(xlUp))
   Set Rng = ShD.Range(ShD.[c2], ShD.[c65500].End(xlUp))
   Sheets("Lech2").Select
 ElseIf Lech > 2 Then
   Set ShN = Sheets("WToE"):        Set ShD = Sheets("PToE")
   Set Rng0 = ShN.Range(ShN.[c3], ShN.[c65500].End(xlUp))
   Set Rng = ShD.Range(ShD.[c2], ShD.[c65500].End(xlUp))
   If Lech = 3 Then
      Sheets("Giong1").Select
   Else
      Sheets("KhacTri").Select
   End If
   [c4].Resize(Rng0.Rows.Count + Rng.Rows.Count, 5).ClearContents
   For Each Cls In Rng0
      Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
      If Not sRng Is Nothing Then
         If Cls.Offset(, 4).Value = sRng.Offset(, 4).Value _
            And Lech = 3 Then
            With [c65500].End(xlUp).Offset(1)
               .Resize(, 5).Value = Cls.Resize(, 5).Value
            End With
         ElseIf Cls.Offset(, 4).Value <> sRng.Offset(, 4).Value _
            And Lech = 4 Then
            With [c65500].End(xlUp).Offset(1)
               .Resize(, 5).Value = Cls.Resize(, 5).Value
               .Offset(1).Resize(, 5).Value = sRng.Resize(, 5).Value
            End With
         End If
      End If
   Next Cls
   Exit Sub
 End If
 [c4].Resize(Rng0.Rows.Count, 5).ClearContents
 Chung12 Lech
 
 Set ShN = Nothing:                 Set ShD = Nothing
 Set sRng = Nothing:                Set Rng0 = Nothing
End Sub
PHP: 
 Sub Chung12(Lech As Byte)
  Dim Cls As Range
 
 For Each Cls In Rng0
   Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
   If sRng Is Nothing Then
      With [c65500].End(xlUp).Offset(1)
         .Resize(, 5).Value = Cls.Resize(, 5).Value
      End With
   End If
 Next Cls
End Sub
 

File đính kèm

Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
hkthuy đã viết:
M đã up lên dữ liệu để thử. Rất mong nhận được sự góp ý của mọi người
Nhấp chuột vào đây để mở rộng...
Giống giống khác khác... tối tăm mặt mũi, Đọc code của HYen17 càng tẩu hỏa nhập ma (tại chưa đủ trình độ để hiểu), lỡ làm bằng công thức và vài cột phụ để tham khảo, hy vọng ra kết quả đúng.
 

File đính kèm

Upvote 0
HYen17 đã viết:
PHP: 
Option Explicit
Dim ShN As Worksheet, ShD As Worksheet
Dim Rng As Range, sRng As Range, Rng0 As Range

Sub HaiTrong1()
 Dim Lech As Byte, Cls As Range
 
 Lech = InputBox("Hay Chon Fuong Án", "1 - Lech 1", "1")
 If Lech = 1 Then
   Set ShN = Sheets("WToE"):        Set ShD = Sheets("PToE")
   Set Rng0 = ShN.Range(ShN.[c3], ShN.[c65500].End(xlUp))
   Set Rng = ShD.Range(ShD.[c2], ShD.[c65500].End(xlUp))
   Sheets("Lech1").Select
 ElseIf Lech = 2 Then
   Set ShD = Sheets("WToE"):        Set ShN = Sheets("PToE")
   Set Rng0 = ShN.Range(ShN.[c3], ShN.[c65500].End(xlUp))
   Set Rng = ShD.Range(ShD.[c2], ShD.[c65500].End(xlUp))
   Sheets("Lech2").Select
 ElseIf Lech > 2 Then
   Set ShN = Sheets("WToE"):        Set ShD = Sheets("PToE")
   Set Rng0 = ShN.Range(ShN.[c3], ShN.[c65500].End(xlUp))
   Set Rng = ShD.Range(ShD.[c2], ShD.[c65500].End(xlUp))
   If Lech = 3 Then
      Sheets("Giong1").Select
   Else
      Sheets("KhacTri").Select
   End If
   [c4].Resize(Rng0.Rows.Count + Rng.Rows.Count, 5).ClearContents
   For Each Cls In Rng0
      Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
      If Not sRng Is Nothing Then
         If Cls.Offset(, 4).Value = sRng.Offset(, 4).Value _
            And Lech = 3 Then
            With [c65500].End(xlUp).Offset(1)
               .Resize(, 5).Value = Cls.Resize(, 5).Value
            End With
         ElseIf Cls.Offset(, 4).Value <> sRng.Offset(, 4).Value _
            And Lech = 4 Then
            With [c65500].End(xlUp).Offset(1)
               .Resize(, 5).Value = Cls.Resize(, 5).Value
               .Offset(1).Resize(, 5).Value = sRng.Resize(, 5).Value
            End With
         End If
      End If
   Next Cls
   Exit Sub
 End If
 [c4].Resize(Rng0.Rows.Count, 5).ClearContents
 Chung12 Lech
 
 Set ShN = Nothing:                 Set ShD = Nothing
 Set sRng = Nothing:                Set Rng0 = Nothing
End Sub
PHP: 
 Sub Chung12(Lech As Byte)
  Dim Cls As Range
 
 For Each Cls In Rng0
   Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
   If sRng Is Nothing Then
      With [c65500].End(xlUp).Offset(1)
         .Resize(, 5).Value = Cls.Resize(, 5).Value
      End With
   End If
 Next Cls
End Sub
Nhấp chuột vào đây để mở rộng...

Chào bạn. Bạn có thể giải thích thêm cho m một chút được chứ. M ko biết nhiều về Excel. Vì thế, đoạn code bạn viết m ko biết là sẽ insert nó vào đâu, hay xử lý nó ntn.
Cảm ơn vì sự giúp đỡ
 
Upvote 0
Hãy vận hành thuần thục với file đính kèm, nha

Chào bạn & có thể giải thích thêm cho m một chút được chứ. M ko biết nhiều về Excel. Vì thế, đoạn code bạn viết m ko biết là sẽ insert nó vào đâu, hay xử lý nó ntn.
Nhấp chuột vào đây để mở rộng...
--=0 --=0

(*) Cách xài 1 macro đã có nhiều trên diễn đàn, nên mình không nhắc lại nữa;

(*) Mình đã gán tổ hợp fím nóng cho macro đó là {CTRL}+{SHIFT}+H; Bạn cần bấm đồng thời chúng nha.
Khi đó 1 hộp thoại xuất hiện. Nó hỏi bạn muốn đi đâu & về đâu; Bạn bấm nhập số '1' nó sẽ làm theo iêu cầu đầu tiên của bạn & đưa ta về trang 'Lech1'; Những lần sau bạn cứ thử với các con số từ '2' đến '4'
Bạn có thể có vài cách kiểm tra sự đúng đắn của macro. Hãy tự làm với dữ liệu giả lập & sau đó đến dữ liệu của bạn.
Macro đang nằm ở đâu trong workbook của bạn thì tự tìm giúp cái nha.

Chúc bạn đạt ước nguyện của mình!
 

File đính kèm

Upvote 0
HYen17 đã viết:
--=0 --=0

(*) Cách xài 1 macro đã có nhiều trên diễn đàn, nên mình không nhắc lại nữa;

(*) Mình đã gán tổ hợp fím nóng cho macro đó là {CTRL}+{SHIFT}+H; Bạn cần bấm đồng thời chúng nha.
Khi đó 1 hộp thoại xuất hiện. Nó hỏi bạn muốn đi đâu & về đâu; Bạn bấm nhập số '1' nó sẽ làm theo iêu cầu đầu tiên của bạn & đưa ta về trang 'Lech1'; Những lần sau bạn cứ thử với các con số từ '2' đến '4'
Bạn có thể có vài cách kiểm tra sự đúng đắn của macro. Hãy tự làm với dữ liệu giả lập & sau đó đến dữ liệu của bạn.
Macro đang nằm ở đâu trong workbook của bạn thì tự tìm giúp cái nha.

Chúc bạn đạt ước nguyện của mình!
Nhấp chuột vào đây để mở rộng...
Chào bạn. Nếu file của m chỉ có 2 cột là MaHang và TongGia thì sẽ chỉnh ntn vậy bạn?
 
Upvote 0
Chào bạn. Nếu file của m chỉ có 2 cột là MaHang và TongGia thì sẽ chỉnh ntn vậy bạn?
Nhấp chuột vào đây để mở rộng...
Thấy file mới nói tiếp cái gì khác, chứ vầy thì dễ "Ông nói gà bà bảo vịt lắm!"
 
Upvote 0
Trong file cũ của m đó. m bỏ đi tất cả các cột khác, chỉ để lại cột MaHang và cột tổng giá
 

File đính kèm

Upvote 0
Nữa buổi để viết lại từ đầu & vẫn dễ hơn sửa

PHP: 
Option Explicit
Dim Sh0 As Worksheet, Rng As Range

Sub ThongKe()
 Dim S0 As Byte, StrC As String, KC As String:                          KC = Space(7)
 Dim Rws As Long:                                  Dim Sh As Worksheet, Rng0 As Range
 
 StrC = "Chon 1 De Xem Mau lech 1;" & Chr(10) & KC & "2 De Xem Mau Lech E;" & Chr(10) _
   & KC & "3 De Xem Gióng Nhau;" & Chr(10) & KC & "4 De Xem Khác Nhau Vè Tong Giá"
 S0 = InputBox(StrC, "GPE.COM Xin Chào!", "1")
 If S0 < 1 Or S0 > 4 Then Exit Sub
 Set Sh0 = _
   Sheets(Switch(S0 = 1, "Lech1", S0 = 2, "Lech2", S0 = 3, "Giong1", S0 = 4, "KhacTri"))
 Select Case S0
 Case 1, 3
   Set Sh = Sheets("PToE"):                                      Sheets("WToE").Select
   Rws = Sh.[b2].CurrentRegion.Rows.Count:               Set Rng = Sh.[b2].Resize(Rws)
   Sh0.[c4].Resize(Rws, 2).ClearContents
   Set Rng0 = [b2].Resize([b2].CurrentRegion.Rows.Count).Offset(1)
   GPE Rng0, S0
 Case 2, 4
   Set Sh = Sheets("WToE"):                                      Sheets("PToE").Select
   Rws = Sh.[b2].CurrentRegion.Rows.Count:               Set Rng = Sh.[b2].Resize(Rws)
   Sh0.[c4].Resize(Rws, 2).ClearContents
   Set Rng0 = [b2].Resize([b2].CurrentRegion.Rows.Count).Offset(1)
   GPE Rng0, S0
 End Select 
End Sub


Mã: 
[B]Sub GPE(Rng0 As Range, Num As Byte)[/B]
 Dim Cls As Range, sRng As Range
 
 For Each Cls In Rng0
   Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
   If sRng Is Nothing Then
      If Num < 3 Then Sh0.[c65500].End(xlUp).Offset(1).Resize(, 2).Value _
         = Cls.Resize(, 2).Value
   Else
      If Num = 3 And Cls.Offset(, 1).Value = sRng.Offset(, 1).Value Then
         Sh0.[c65500].End(xlUp).Offset(1).Resize(, 2).Value = Cls.Resize(, 2).Value
      ElseIf Num > 3 And Cls.Offset(, 1).Value <> sRng.Offset(, 1).Value Then
         Sh0.[c65500].End(xlUp).Offset(1).Resize(, 2).Value = Cls.Resize(, 2).Value
      End If
   End If
 Next Cls
 Sh0.Select:                                                         Set Sh0 = Nothing
End Sub
 

File đính kèm

Upvote 0
Chào bạn. M đã coi bài của bạn. phần 1,2,3 thì ok. Nhưng trong phần 4 (lọc những MaHang giống nhau nhưng có TongGia khác nhau), nếu m muốn in ra các cặp sai TongGia thì giải pháp sẽ ntn? M lấy ví dụ cụ thể hơn, nếu tìm thấy MaHang = 123456 trong sheet WToE là 100 000 VND, trong sheet PToE là 120 000 VND.
Làm cách nào để trong sheet KhacTri (chọn 4) in ra định dạng table 4 cột như sau
STT_____MaHang____WToE______PToE
1_______123456_____100 000____120 000
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Sẵn lòng thôi, xin mời!

PHP: 
Option Explicit
Dim Sh0 As Worksheet, Rng As Range

Sub ThongKe()
 Dim S0 As Byte, StrC As String, KC As String:                          KC = Space(7)
 Dim Rws As Long:                                  Dim Sh As Worksheet, Rng0 As Range
 
 StrC = "Chon 1 De Xem Mau lech 1;" & Chr(10) & KC & "2 De Xem Mau Lech E;" & Chr(10) _
   & KC & "3 De Xem Gióng Nhau;" & Chr(10) & KC & "4 De Xem Khác Nhau Vè Tong Giá"
 S0 = InputBox(StrC, "GPE.COM Xin Chào!", "1")
 If S0 < 1 Or S0 > 4 Then Exit Sub
 Set Sh0 = _
   Sheets(Switch(S0 = 1, "Lech1", S0 = 2, "Lech2", S0 = 3, "Giong1", S0 = 4, "KhacTri"))
 Select Case S0
 Case 1, 3
   Set Sh = Sheets("PToE"):                                      Sheets("WToE").Select
   Rws = Sh.[b2].CurrentRegion.Rows.Count:               Set Rng = Sh.[b2].Resize(Rws)
   Sh0.[c4].Resize(Rws, 2).ClearContents
   Set Rng0 = [b2].Resize([b2].CurrentRegion.Rows.Count).Offset(1)
   GPE Rng0, S0
 Case 2, 4
   Set Sh = Sheets("WToE"):                                      Sheets("PToE").Select
   Rws = Sh.[b2].CurrentRegion.Rows.Count:               Set Rng = Sh.[b2].Resize(Rws)
   Sh0.[c4].Resize(Rws, 2).ClearContents
   Set Rng0 = [b2].Resize([b2].CurrentRegion.Rows.Count).Offset(1)
1   If S0 = 4 Then
      Sh0.[d3].Value = Sheets("PToE").Name:                       Sh0.[E3] = Sh.Name
2   End If
   GPE Rng0, S0
 End Select
 
End Sub
Mã: 
[B]Sub GPE(Rng0 As Range, Num As Byte)[/B]
 Dim Cls As Range, sRng As Range
 
 For Each Cls In Rng0
   Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
   If sRng Is Nothing Then
      If Num < 3 Then Sh0.[c65500].End(xlUp).Offset(1).Resize(, 2).Value _
         = Cls.Resize(, 2).Value
   Else
      If Num = 3 And Cls.Offset(, 1).Value = sRng.Offset(, 1).Value Then
         Sh0.[c65500].End(xlUp).Offset(1).Resize(, 2).Value = Cls.Resize(, 2).Value
      ElseIf Num > 3 And Cls.Offset(, 1).Value <> sRng.Offset(, 1).Value Then
[COLOR=Blue]3[/COLOR]         With Sh0.[c65500].End(xlUp).Offset(1)
            .Resize(, 2).Value = Cls.Resize(, 2).Value
[COLOR=RoyalBlue]5[/COLOR]            .Offset(, 2).Value = sRng.Offset(, 1).Value
[COLOR=RoyalBlue]6 [/COLOR]        End With
      End If
   End If
 Next Cls
 Sh0.Select:                                                         Set Sh0 = Nothing
[B]End Sub[/B]
 
Upvote 0
Hi.
Mình có chút khó khăn mới trong chương trình này. Yêu cầu mới bắt buộc mình phải thể hiện sự khác nhau trong hai file. Mình không rành về Excel. Mình rất mong nhận được sự giúp đỡ của GPE. Cảm ơn mọi người đã ghé đọc tin.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
File trống trơn thì đưa lên làm gì vậy bạn?
 
Upvote 0
Xl, Mình quên không bổ xung dữ liệu thử. Mọi người giúp mình
 
Upvote 0
Có ai giúp mình. GPE ơi! Tôi cần sự giúp đỡ. Sắp bị gõ đầu rùi.
 
Upvote 0
hkthuy đã viết:
Hi.
Mình có chút khó khăn mới trong chương trình này. Yêu cầu mới bắt buộc mình phải thể hiện sự khác nhau trong hai file. Mình không rành về Excel. Mình rất mong nhận được sự giúp đỡ của GPE. Cảm ơn mọi người đã ghé đọc tin.
Nhấp chuột vào đây để mở rộng...
Đọc trong file thì đây là yêu cầu so sánh 2 list:
- Tìm cái có trong A mà không có trong B
- Tìm cái có trong B mà không có trong A
- Tìm cái có trong cả A và B
vân vân...
Dạng này đã được làm nhiều lần trên GPE rồi ---> Nếu có thể được, bạn đưa dữ liệu nhiều 1 chút (làm mới đã tay) ---> Tóm lại, dữ liệu của bạn dài đến bao nhiêu hãy đưa hết lên càng tốt
 
Upvote 0
Đó 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!^^
 
Upvote 0
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.

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

T
Nhờ các anh chị sửa dùm công thức ạ. (1 người xem)
Trả lời
10
Đọc
113
trantrungvinh1989
T
T
Tìm số hóa đơn trong chuỗi (1 người xem)
Trả lời
10
Đọc
382
tranhungdao12a3
T
C
Chia sẻ: Kết quả xổ số Keno (1 người xem)
    • Cười
    • Thích
Trả lời
24
Đọc
2K
phuongdaik98
P
Phan Thế Hiệp
Quy đổi từ Thu nhập sau thuế (TNCN) ra Thu nhập tính thuế
    • Yêu thích
    • Thích
Trả lời
1
Đọc
270
Phan Thế Hiệp
Phan Thế Hiệp
V
Quên mật khẩu file excel (1 người xem)
Trả lời
25
Đọc
2K
YêuCN
Y
Nguyen Rem
  • Question Question
Lỗi "User-defined type not defined" khi khai báo biến
Trả lời
28
Đọc
2K
nguyendang95
N
E
Đánh số cho các cặp số chứng từ và số chứng từ đối ứng
Trả lời
13
Đọc
259
dazkangel
dazkangel
NguyenthiH
Mở file Excel có Pass Open
Trả lời
37
Đọc
3K
kimthoa26
kimthoa26
OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản."
    • Thích
    • Yêu thích
Trả lời
5
Đọc
1K
longlacda
L
V
Công thức để phân công chuyên môn cho giáo viên
Trả lời
5
Đọc
274
vietvanyen
V
G
AddIn convert ngày dương lịch sang âm lịch và ngược lại + đọc ngày tháng (1 người xem)
Trả lời
20
Đọc
10K
du trung kien
D
8
Hàm trong excel
Trả lời
3
Đọc
74
Hoàng Tuấn 868
H
N
Chuyển giờ công từ bảng công vào bảng tính
Trả lời
16
Đọc
299
ngouyen1505
N
N
Tạo COM Add-In bằng Visual C++
    • Thích
Trả lời
7
Đọc
679
nguyendang95
N
Nga1852k
lỗi excel không chèn được dòng và không xóa được dòng
Trả lời
2
Đọc
139
Nga1852k
Nga1852k
D
  • Question Question
xin các cao thủ trợ giúp , hoặc nhận làm code có trả phí ạ
Trả lời
14
Đọc
1K
tung1423
tung1423
D
xin hỏi về lỗi mô đun ẩn. (1 người xem)
Trả lời
3
Đọc
151
ongke0711
ongke0711
H
Xin anh chị hướng dẫn công thức excel ạ.
Trả lời
9
Đọc
302
Phan Thế Hiệp
Phan Thế Hiệp
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
381
Đọc
45K
tuanktt3
T
M
Add-in Excel kết nối cơ sở dữ liệu
Trả lời
1
Đọc
118
ptm0412
ptm0412
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom