Tổng hợp Dữ liệu (2 người xem)

maixuanvuong276 · 3/12/21

Nhờ các bạn bro giúp mình vấn đề này ạ, Ý em là cả 2 sheet đều có dữ liệu, có cấu trúc giống nhau, nhưng Sp ở sheet 1 có thể có ở sheet 2 hoặc không có, nên giờ em mong muốn là tổng hợp sheet 1 vào sheet2, nếu cùng SP thì cộng dồn,chưa có thi thêm vào ý ạ!file em đính kèm bên dưới, mong các bro giúp đỡ! Tks các bro nhiều !. Văn thơ còn kém mong mọi người thông cảm ạ! Cảm ơn nhiều ạ!

Hai Lúa Miền Tây · 3/12/21

maixuanvuong276 đã viết:
Nhờ các bạn bro giúp mình vấn đề này ạ, Ý em là cả 2 sheet đều có dữ liệu, có cấu trúc giống nhau, nhưng Sp ở sheet 1 có thể có ở sheet 2 hoặc không có, nên giờ em mong muốn là tổng hợp sheet 1 vào sheet2, nếu cùng SP thì cộng dồn,chưa có thi thêm vào ý ạ!file em đính kèm bên dưới, mong các bro giúp đỡ! Tks các bro nhiều !. Văn thơ còn kém mong mọi người thông cảm ạ! Cảm ơn nhiều ạ!

Bạn thử code sau nhé:

Mã:

Sub TongHopDL_HLMT()
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=NO"""
        Sheet2.Range("K4").CopyFromRecordset .Execute("Select F1,F2,Sum(F3),F4,Sum(F5) From (Select * From [Sheet1$C4:G18] Where F1 Is Not Null Union All Select * From [Sheet2$C4:G18] Where F1 Is Not Null) Group By F1,F2,F4")
    End With
End Sub

vanaccex · 3/12/21

maixuanvuong276 đã viết:
Nhờ các bạn bro giúp mình vấn đề này ạ, Ý em là cả 2 sheet đều có dữ liệu, có cấu trúc giống nhau, nhưng Sp ở sheet 1 có thể có ở sheet 2 hoặc không có, nên giờ em mong muốn là tổng hợp sheet 1 vào sheet2, nếu cùng SP thì cộng dồn,chưa có thi thêm vào ý ạ!file em đính kèm bên dưới, mong các bro giúp đỡ! Tks các bro nhiều !. Văn thơ còn kém mong mọi người thông cảm ạ! Cảm ơn nhiều ạ!

Xem thử cách này

maixuanvuong276 · 3/12/21

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

Bạn thử code sau nhé:

Mã:

Sub TongHopDL_HLMT()
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=NO"""
        Sheet2.Range("K4").CopyFromRecordset .Execute("Select F1,F2,Sum(F3),F4,Sum(F5) From (Select * From [Sheet1$C4:G18] Where F1 Is Not Null Union All Select * From [Sheet2$C4:G18] Where F1 Is Not Null) Group By F1,F2,F4")
    End With
End Sub

Em cảm ơn anh nhiều! Mà a ơi nếu Dữ liệu kia cập nhật luôn vào bảng của sheet2 được không ạ.

echo07 · 3/12/21

maixuanvuong276 đã viết:
Em cảm ơn anh nhiều! Mà a ơi nếu Dữ liệu kia cập nhật luôn vào bảng của sheet2 được không ạ.

Dữ liệu của bạn ở cả 2 sheet và chắc chắn còn cập nhật thêm, vậy bạn muốn code hay công thức gộp tiếp vào cho bạn vậy chả phải vừa làm thủ công vừa code à. Thường thì dữ liệu nào còn cập nhật, thay đổi thì để riêng, cái tổng hợp sẽ dùng công thức hoặc code để lấy.
Như ở bài #3 tác giả sử dụng Power Query thấy rất tiện, hai sheet kia bạn update thoải mái, kết quả sẽ có ở trong sheet Table2 (nhớ Refresh để load dữ liệu)

maixuanvuong276 · 3/12/21

echo07 đã viết:
Dữ liệu của bạn ở cả 2 sheet và chắc chắn còn cập nhật thêm, vậy bạn muốn code hay công thức gộp tiếp vào cho bạn vậy chả phải vừa làm thủ công vừa code à. Thường thì dữ liệu nào còn cập nhật, thay đổi thì để riêng, cái tổng hợp sẽ dùng công thức hoặc code để lấy.
Như ở bài #3 tác giả sử dụng Power Query thấy rất tiện, hai sheet kia bạn update thoải mái, kết quả sẽ có ở trong sheet Table2 (nhớ Refresh để load dữ liệu)

ý em là gộp trực tiếp qua bảng dữ liệu trong sheet 2 luôn, chứ không cần ra kết quả ở K4 ý ạ! tks anh!

BuiQuangThuan · 3/12/21

maixuanvuong276 đã viết:
ý em là gộp trực tiếp qua bảng dữ liệu trong sheet 2 luôn, chứ không cần ra kết quả ở K4 ý ạ! tks anh!

dữ liệu thật có nhiều không

HUONGHCKT · 4/12/21

maixuanvuong276 đã viết:
Nhờ các bạn bro giúp mình vấn đề này ạ, Ý em là cả 2 sheet đều có dữ liệu, có cấu trúc giống nhau, nhưng Sp ở sheet 1 có thể có ở sheet 2 hoặc không có, nên giờ em mong muốn là tổng hợp sheet 1 vào sheet2, nếu cùng SP thì cộng dồn,chưa có thi thêm vào ý ạ!file em đính kèm bên dưới, mong các bro giúp đỡ! Tks các bro nhiều !. Văn thơ còn kém mong mọi người thông cảm ạ! Cảm ơn nhiều ạ!

Góp vui , hãy thử xem.

Mã:

Option Explicit

Sub ABC()
Dim i&, j&, Lr&, LrD, t&, k&
Dim Arr(), ArrD(), KQ(), Keys As Variant
Dim Dic As Object

With Sheet2
LrD = .Cells(Rows.Count, 2).End(xlUp).Row
ArrD = .Range("C4:G" & LrD).Value
End With
With Sheet1
Lr = .Cells(Rows.Count, 2).End(xlUp).Row
Arr = .Range("C4:G" & Lr).Value
End With
Set Dic = CreateObject("Scripting.Dictionary")
ReDim KQ(1 To UBound(Arr) + UBound(ArrD), 1 To 7)

For i = 1 To UBound(Arr)
If Arr(i, 1) <> Empty Then
    Keys = Arr(i, 1)
    If Not Dic.exists(Keys) Then
        t = t + 1
        Dic.Add (Keys), t
            KQ(t, 1) = t
        For j = 1 To UBound(Arr, 2)
            KQ(t, j + 1) = Arr(i, j)
        Next j
    Else
        k = Dic.Item(Keys)
            KQ(k, 4) = KQ(k, 4) + Arr(i, 3)
            KQ(k, 6) = KQ(k, 6) + Arr(i, 5)
    End If
End If
Next i
For i = 1 To UBound(ArrD)
If ArrD(i, 1) <> Empty Then
    Keys = ArrD(i, 1)
    If Not Dic.exists(Keys) Then
        t = t + 1
        Dic.Add (Keys), t
            KQ(t, 1) = t
        For j = 1 To UBound(ArrD, 2)
            KQ(t, j + 1) = ArrD(i, j)
        Next j
    Else
        k = Dic.Item(Keys)
            KQ(k, 4) = KQ(k, 4) + ArrD(i, 3)
            KQ(k, 6) = KQ(k, 6) + ArrD(i, 5)
    End If
End If
Next i
If t Then
    Sheet2.Range("B4").Resize(1000, 6).ClearContents
    Sheet2.Range("B4").Resize(t, 6) = KQ
End If
Set Dic = Nothing
End Sub

HieuCD · 4/12/21

HUONGHCKT đã viết:

Góp vui , hãy thử xem.

Mã:

Option Explicit

Sub ABC()
Dim i&, j&, Lr&, LrD, t&, k&
Dim Arr(), ArrD(), KQ(), Keys As Variant
Dim Dic As Object

With Sheet2
LrD = .Cells(Rows.Count, 2).End(xlUp).Row
ArrD = .Range("C4:G" & LrD).Value
End With
With Sheet1
Lr = .Cells(Rows.Count, 2).End(xlUp).Row
Arr = .Range("C4:G" & Lr).Value
End With
Set Dic = CreateObject("Scripting.Dictionary")
ReDim KQ(1 To UBound(Arr) + UBound(ArrD), 1 To 7)

For i = 1 To UBound(Arr)
If Arr(i, 1) <> Empty Then
    Keys = Arr(i, 1)
    If Not Dic.exists(Keys) Then
        t = t + 1
        Dic.Add (Keys), t
            KQ(t, 1) = t
        For j = 1 To UBound(Arr, 2)
            KQ(t, j + 1) = Arr(i, j)
        Next j
    Else
        k = Dic.Item(Keys)
            KQ(k, 4) = KQ(k, 4) + Arr(i, 3)
            KQ(k, 6) = KQ(k, 6) + Arr(i, 5)
    End If
End If
Next i
For i = 1 To UBound(ArrD)
If ArrD(i, 1) <> Empty Then
    Keys = ArrD(i, 1)
    If Not Dic.exists(Keys) Then
        t = t + 1
        Dic.Add (Keys), t
            KQ(t, 1) = t
        For j = 1 To UBound(ArrD, 2)
            KQ(t, j + 1) = ArrD(i, j)
        Next j
    Else
        k = Dic.Item(Keys)
            KQ(k, 4) = KQ(k, 4) + ArrD(i, 3)
            KQ(k, 6) = KQ(k, 6) + ArrD(i, 5)
    End If
End If
Next i
If t Then
    Sheet2.Range("B4").Resize(1000, 6).ClearContents
    Sheet2.Range("B4").Resize(t, 6) = KQ
End If
Set Dic = Nothing
End Sub

Hai "With" và hai "for" giống y chang, gôm lại cho gọn code được không bạn

BuiQuangThuan · 4/12/21

Code bài 2 sịn sò thế là đáp ứng được bài của bạn ấy rồi mà không dùng nhỉ.

HieuCD · 4/12/21

maixuanvuong276 đã viết:
Nhờ các bạn bro giúp mình vấn đề này ạ, Ý em là cả 2 sheet đều có dữ liệu, có cấu trúc giống nhau, nhưng Sp ở sheet 1 có thể có ở sheet 2 hoặc không có, nên giờ em mong muốn là tổng hợp sheet 1 vào sheet2, nếu cùng SP thì cộng dồn,chưa có thi thêm vào ý ạ!file em đính kèm bên dưới, mong các bro giúp đỡ! Tks các bro nhiều !. Văn thơ còn kém mong mọi người thông cảm ạ! Cảm ơn nhiều ạ!

Có khi nào cùng 1 sản phẩm nhưng đơn giá 2 sheet khác nhau?

BuiQuangThuan · 4/12/21

maixuanvuong276 đã viết:
ý em là gộp trực tiếp qua bảng dữ liệu trong sheet 2 luôn, chứ không cần ra kết quả ở K4 ý ạ! tks anh!

Cứ sau n lần bấm thì nó còn loạn cào cào lên luôn ấy

Mã:

Option Explicit
Sub ABC()
    Dim Arr(0 To 1), Dic As Object, Res(), x&, Sht
    Dim K&, i&, ii&, KK&
    Set Dic = CreateObject("Scripting.dictionary")
    Sht = Array("Sheet1", "Sheet2")
    ReDim Res(1 To 15, 1 To 6)
    For i = 1 To 0 Step -1
        Arr(i) = Sheets(Sht(i)).Range("C4:H18").Value
        For ii = 1 To UBound(Arr(i))
            If Arr(i)(ii, 1) <> "" Then
                If Dic.exists(Arr(i)(ii, 1)) = False Then
                    K = K + 1
                    Dic.Add Arr(i)(ii, 1), K
                    For x = 1 To 6
                        Res(K, x) = Arr(i)(ii, x)
                    Next
                Else
                    KK = Dic(Arr(i)(ii, 1))
                    Res(KK, 4) = Res(KK, 4) + Arr(i)(ii, 4)
                    Res(KK, 5) = Res(KK, 5) + Arr(i)(ii, 5)
                End If
            End If
        Next
    Next
    Sheets("Sheet2").Range("C4:H15").Value = Res
End Sub

HUONGHCKT · 4/12/21

HieuCD đã viết:
Hai "With" và hai "for" giống y chang, gôm lại cho gọn code được không bạn

Cảm ơn anh đã xen bài và cho nhận xét.
Thực tình là tôi không biết nối 2 mảng vói nhau thì phải làm thế nào, nên làm cách củ chuối ấy vậy, Chỉ đơn thuần nghĩ, Code chạy hết mảng 1 rồi chạy tiếp mảng 2 thì phải for 2 lần và xét dic. Nếu có thể Anh hướng dẫn tôi (và có thể có rất nhiều thành viên nữa chưa được biết thuật toán và code này được học tập thêm kiến thức) cách nối 2 hoặc nhiều mảng với nhau thì tuyệt vời làm sao.
Trân trọng cảm ơn.

HieuCD · 4/12/21

HUONGHCKT đã viết:
Cảm ơn anh đã xen bài và cho nhận xét.
Thực tình là tôi không biết nối 2 mảng vói nhau thì phải làm thế nào, nên làm cách củ chuối ấy vậy, Chỉ đơn thuần nghĩ, Code chạy hết mảng 1 rồi chạy tiếp mảng 2 thì phải for 2 lần và xét dic. Nếu có thể Anh hướng dẫn tôi (và có thể có rất nhiều thành viên nữa chưa được biết thuật toán và code này được học tập thêm kiến thức) cách nối 2 hoặc nhiều mảng với nhau thì tuyệt vời làm sao.
Trân trọng cảm ơn.

Bạn tham khảo cách làm bài #12 của @BuiQuangThuan

maixuanvuong276 · 5/12/21

BuiQuangThuan đã viết:

Cứ sau n lần bấm thì nó còn loạn cào cào lên luôn ấy

Mã:

Option Explicit
Sub ABC()
    Dim Arr(0 To 1), Dic As Object, Res(), x&, Sht
    Dim K&, i&, ii&, KK&
    Set Dic = CreateObject("Scripting.dictionary")
    Sht = Array("Sheet1", "Sheet2")
    ReDim Res(1 To 15, 1 To 6)
    For i = 1 To 0 Step -1
        Arr(i) = Sheets(Sht(i)).Range("C4:H18").Value
        For ii = 1 To UBound(Arr(i))
            If Arr(i)(ii, 1) <> "" Then
                If Dic.exists(Arr(i)(ii, 1)) = False Then
                    K = K + 1
                    Dic.Add Arr(i)(ii, 1), K
                    For x = 1 To 6
                        Res(K, x) = Arr(i)(ii, x)
                    Next
                Else
                    KK = Dic(Arr(i)(ii, 1))
                    Res(KK, 4) = Res(KK, 4) + Arr(i)(ii, 4)
                    Res(KK, 5) = Res(KK, 5) + Arr(i)(ii, 5)
                End If
            End If
        Next
    Next
    Sheets("Sheet2").Range("C4:H15").Value = Res
End Sub

Tks anh rất nhiều ạ!

Bài đã được tự động gộp: 5/12/21

HieuCD đã viết:
Có khi nào cùng 1 sản phẩm nhưng đơn giá 2 sheet khác nhau?

dạ cùng SP thì cùng 1 đơn giá ạ, nhưng 2 thời điểm khác nhau, xếp bảo gộp chung lại ạ.

Tổng hợp Dữ liệu (2 người xem)

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

maixuanvuong276

Thành viên mới

File đính kèm

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆

vanaccex

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

File đính kèm

maixuanvuong276

Thành viên mới

echo07

Nguyệt Hà

maixuanvuong276

Thành viên mới

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

HUONGHCKT

Zalo 0986997214

HieuCD

Chuyên gia GPE

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

HieuCD

Chuyên gia GPE

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

HUONGHCKT

Zalo 0986997214

HieuCD

Chuyên gia GPE

maixuanvuong276

Thành viên mới

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

Đếm ngược thời gian