Hỏi về so sánh dữ liệu giữa 2 bảng và đưa ra bảng tổng (6 người xem)

Liên hệ QC

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

netvietcomputer

Thành viên mới
Tham gia
5/7/09
Bài viết
42
Được thích
1
Câu hỏi như tiêu đề. Cụ thể vui lòng mở file đính kèm. Cảm ơn mọi người
 

File đính kèm

Trường hợp trong type1 có 2 số liệu trùng và type2 cũng như vậy và = type1 thì thế nào
VD : [A3:B4] bằng [E3:F4] thì "quant" sẽ tính thế nào
 
À quên!
Type1 và color1 trùng nhau thì cộng lại, tương tự cho bên bảng 2.
Ví dụ: I3= C3+C4+G3+G4 vì A3+B3 giống A4+B4 và giống E3+E4, F3+F4
THank's pro
 
Như thế này cho đơn giản hơn @gtri này: Mình gộp 2 bảng thành 1 sau đó tìm điều kiện nếu Type và color giống nhau thì cộng quant lại. Giúp mình nhé! thank's
 
Như thế này cho đơn giản hơn @gtri này: Mình gộp 2 bảng thành 1 sau đó tìm điều kiện nếu Type và color giống nhau thì cộng quant lại. Giúp mình nhé! thank's

Cái này dùng VBA cho tiện.
Chạy đoạn code này, kết quả dán vào sheet3
Mã:
Public Sub Tong_Hop()
Dim DL1, DL2, Tam, kq(), r As Long, i, j

With Sheet2
DL1 = .Range("A3", .Range("C65000").End(xlUp))
DL2 = .Range("E3", .Range("G65000").End(xlUp))
ReDim kq(1 To UBound(DL1) + UBound(DL2), 1 To 3)
End With

With CreateObject("Scripting.Dictionary")
For r = 1 To UBound(DL1) + UBound(DL2)
If r <= UBound(DL1) Then
Tam = DL1(r, 1) & "#" & DL1(r, 2): i = DL1(r, 3): j = Array(1, i)
Else
Tam = DL2(r - UBound(DL1), 1) & "#" & DL2(r - UBound(DL1), 2): i = DL2(r - UBound(DL1), 3): j = Array(1, i)
End If

If Not .exists(Tam) Then
.Add Tam, j
Else
j = .Item(Tam)
j(0) = j(0) + 1: j(1) = j(1) + i
.Item(Tam) = j
End If
Next r
Tam = .keys

i = 0
For r = 0 To UBound(Tam)
If .Item(Tam(r))(0) > 1 Then
i = i + 1
kq(i, 1) = Split(Tam(r), "#")(0)
kq(i, 2) = Split(Tam(r), "#")(1)
kq(i, 3) = .Item(Tam(r))(1)
End If
Next r
End With

Sheet3.Range("A1").Resize(i, 3).Value = kq
End Sub
 
Cái này dùng VBA cho tiện.
Chạy đoạn code này, kết quả dán vào sheet3
Mã:
Public Sub Tong_Hop()
Dim DL1, DL2, Tam, kq(), r As Long, i, j

With Sheet2
DL1 = .Range("A3", .Range("C65000").End(xlUp))
DL2 = .Range("E3", .Range("G65000").End(xlUp))
ReDim kq(1 To UBound(DL1) + UBound(DL2), 1 To 3)
End With

With CreateObject("Scripting.Dictionary")
For r = 1 To UBound(DL1) + UBound(DL2)
If r <= UBound(DL1) Then
Tam = DL1(r, 1) & "#" & DL1(r, 2): i = DL1(r, 3): j = Array(1, i)
Else
Tam = DL2(r - UBound(DL1), 1) & "#" & DL2(r - UBound(DL1), 2): i = DL2(r - UBound(DL1), 3): j = Array(1, i)
End If

If Not .exists(Tam) Then
.Add Tam, j
Else
j = .Item(Tam)
j(0) = j(0) + 1: j(1) = j(1) + i
.Item(Tam) = j
End If
Next r
Tam = .keys

i = 0
For r = 0 To UBound(Tam)
If .Item(Tam(r))(0) > 1 Then
i = i + 1
kq(i, 1) = Split(Tam(r), "#")(0)
kq(i, 2) = Split(Tam(r), "#")(1)
kq(i, 3) = .Item(Tam(r))(1)
End If
Next r
End With

Sheet3.Range("A1").Resize(i, 3).Value = kq
End Sub
THank's bác.
Nhưng em gà lắm, chưa biết chạy VBA.
Bác có link hướng dẫn chạy nó ko?
 
Mở file, nhấn nút "TÌM"
Về VBA có lẽ bạn chủ động tìm hiểu đi vậy, trên diễn đàn rất nhiều bài tương tự.
Rồi bác lại dọn sẵn cơm cho ăn rồi! --=0
Sau này nếu cần tính toán thì chỉ cần copy dữ liệu vào 2 cái bảng kia thôi phải không bác?
THank bác!
 
Ô có chút gì đó ko ổn
quant1 + quant 2 phải bằng 206 nhưng ở sheet3 chỉ có 186 thôi ạ!
 
Hình như nếu type 1 và type 2 thì VBA không tính thì phải
 
Cái này Remove duplicates rồi dùng sumif cho nhanh nếu k biết VBA
 
Dạ đây ạ. Chênh lệch giữa tổng quant1+quant2 và phần tổng hợp ở sheet3

Cái này là do bạn diễn đạt trong sheet02 chưa rõ ràng
"Nếu Type1 và color1 ở bảng 1 giống Type2 và color2 ở bảng 2 thì điền vào Type"
Chỉ viết có vậy thì hiểu rằng nếu không giống nhau thì không điền--->sẽ không có quant tương ứng
---
Chạy thử file đính kèm, vẫn code cũ, thay đổi điều kiện truy xuất.

---
Bài này dùng PivotTable mới là chuẩn nhất
 

File đính kèm

Cái này là do bạn diễn đạt trong sheet02 chưa rõ ràng
"Nếu Type1 và color1 ở bảng 1 giống Type2 và color2 ở bảng 2 thì điền vào Type"
Chỉ viết có vậy thì hiểu rằng nếu không giống nhau thì không điền--->sẽ không có quant tương ứng
---
Chạy thử file đính kèm, vẫn code cũ, thay đổi điều kiện truy xuất.

---
Bài này dùng PivotTable mới là chuẩn nhất
Ok rồi! do em diễn đạt chưa đầy đủ. Thank's bác đã nhiệt tình}}}}}}}}}}}}}}}
 
Ok rồi! do em diễn đạt chưa đầy đủ. Thank's bác đã nhiệt tình}}}}}}}}}}}}}}}

Nếu vậy thì tham gia thêm 1 Sub:
PHP:
Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, J As Long, Tem As String, K As Long, R As Long
Set Dic = CreateObject("Scripting.Dictionary")
R = [A65536].End(xlUp).Row
If [E65536].End(xlUp).Row > R Then R = [E65536].End(xlUp).Row
sArr = Range("A3:G3").Resize(R).Value
ReDim dArr(1 To UBound(sArr, 1) * 2, 1 To 3)
For J = 1 To 5 Step 4
    For I = 1 To UBound(sArr, 1)
        If sArr(I, J) <> Empty Then
            Tem = sArr(I, J) & "#" & sArr(I, J + 1)
            If Not Dic.exists(Tem) Then
                K = K + 1
                Dic.Item(Tem) = K
                dArr(K, 1) = sArr(I, J)
                dArr(K, 2) = sArr(I, J + 1)
                dArr(K, 3) = sArr(I, J + 2)
            Else
                dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(I, J + 2)
            End If
        End If
    Next I
Next J
[I3:K1000].ClearContents
[I3].Resize(K, 3) = dArr
Set Dic = Nothing
End Sub
 

File đính kèm

Nếu vậy thì tham gia thêm 1 Sub:
PHP:
Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), I As Long, J As Long, Tem As String, K As Long, R As Long
Set Dic = CreateObject("Scripting.Dictionary")
R = [A65536].End(xlUp).Row
If [E65536].End(xlUp).Row > R Then R = [E65536].End(xlUp).Row
sArr = Range("A3:G3").Resize(R).Value
ReDim dArr(1 To UBound(sArr, 1) * 2, 1 To 3)
For J = 1 To 5 Step 4
    For I = 1 To UBound(sArr, 1)
        If sArr(I, J) <> Empty Then
            Tem = sArr(I, J) & "#" & sArr(I, J + 1)
            If Not Dic.exists(Tem) Then
                K = K + 1
                Dic.Item(Tem) = K
                dArr(K, 1) = sArr(I, J)
                dArr(K, 2) = sArr(I, J + 1)
                dArr(K, 3) = sArr(I, J + 2)
            Else
                dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(I, J + 2)
            End If
        End If
    Next I
Next J
[I3:K1000].ClearContents
[I3].Resize(K, 3) = dArr
Set Dic = Nothing
End Sub
Thank's pro! các bác support đến tận chân răng thế này chắc em dốt mãi thoai --=0--=0--=0--=0
 
Thank's pro! các bác support đến tận chân răng thế này chắc em dốt mãi thoai --=0--=0--=0--=0

Đúng thế, bạn nên tự tìm hiểu kỹ, và viết lại CODE cho đẹp hơn, hoặc theo hiểu biết của mình, thì sẽ dần hết dốt thôi, còn cứ trông chờ họ cho tận buffer thế này thì cũng hay
 
Lần chỉnh sửa cuối:
Web KT

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

Back
Top Bottom