Xin giúp em tổng họp 2 sheet vào sheet tổng họp

Liên hệ QC

happyghost2000

Thành viên chính thức
Tham gia
24/5/08
Bài viết
70
Được thích
6
Em có file : trong file có 3 sheet
Sheet 1
Sheet 2
Sheet tong hop
Em có viết code tổng họp chạy lỗi không ra được kết quả.
Mong Anh, Chị giúp code giúp em .
Mục tiêu ở sheet tổng họp họp nếu trùng nhau thì số liệu được công dồn ( lấy trường 1,2,3,4 làm khóa chính )
lưu ý Sheet 2 cột 3 dùm Trim thì mới trùng với cột 3 của Sheet 1 .
Mong Anh Chị giúp em .
Cám ơn Anh, Chị Thật nhiều .
 

File đính kèm

  • thongketonkho.xlsm
    523.4 KB · Đọc: 19
Em có file : trong file có 3 sheet
Sheet 1
Sheet 2
Sheet tong hop
Em có viết code tổng họp chạy lỗi không ra được kết quả.
Mong Anh, Chị giúp code giúp em .
Mục tiêu ở sheet tổng họp họp nếu trùng nhau thì số liệu được công dồn ( lấy trường 1,2,3,4 làm khóa chính )
lưu ý Sheet 2 cột 3 dùm Trim thì mới trùng với cột 3 của Sheet 1 .
Mong Anh Chị giúp em .
Cám ơn Anh, Chị Thật nhiều .
Do không đọc được các tiêu đề nên viết theo ý hiểu (Mục tiêu ở sheet tổng họp họp nếu trùng nhau thì số liệu được công dồn ( lấy trường 1,2,3,4 làm khóa chính ), nên tôi sửa lại code của bạn như sau, hy vọng là đúng ý, và nếu có sai thì chắc bạn tự sửa được.
Mã:
Sub Thongke()
Dim Dic As Object
Dim Arr_N(), Arr_M(), Res(), Rng_D As Range
Dim Dcuoi As Long, Dcuoi2&
Dim i As Long, j As Long, k As Long, t&, tt&

Dcuoi = Sheet1.Range("A10000").End(xlUp).Row
Arr_N = Sheet1.Range("A3:U" & Dcuoi).Value

Dcuoi2 = Sheet2.Range("A10000").End(xlUp).Row
Arr_M = Sheet2.Range("A4:L" & Dcuoi2).Value
Set Dic = CreateObject("Scripting.Dictionary")
ReDim Res(1 To UBound(Arr_N) + UBound(Arr_M), 1 To 27)

For i = 1 To UBound(Arr_N, 1)
Key = Arr_N(i, 1) & "#" & Arr_N(i, 2) & "#" & Arr_N(i, 3) & "#" & Arr_N(i, 4)
    If Not Dic.Exists(Key) Then
        k = k + 1
        Dic.Add (Key), k
        For j = 1 To 21
            Res(k, j) = Arr_N(i, j)
        Next j
    Else
        t = Dic.Item(Key)
            For j = 6 To 21
                Res(t, j) = Res(t, j) + Arr_N(i, j)
            Next j
    End If
Next

For i = 1 To UBound(Arr_M, 1)
    Key = Arr_M(i, 1) & "#" & Arr_M(i, 2) & "#" & Trim(Arr_M(i, 3)) & "#" & Arr_M(i, 4)

    If Not Dic.Exists(Key) Then
        k = k + 1
        Dic.Add (Key), k
        For j = 1 To 4
            Res(k, j) = Arr_M(i, j)
        Next j
        For j = 7 To 12
            Res(k, j + 15) = Arr_M(i, j)
        Next j
    Else
        tt = Dic.Item(Key)
        For j = 7 To 12
            Res(tt, j + 15) = Res(tt, j + 15) + Arr_M(i, j)
        Next j
    End If
Next
If k Then
    Sheet3.Range("A2:AA100000").ClearContents
    Sheet3.Range("A2").Resize(k, 27) = Res
End If
    Set Dic = Nothing
End Sub
 
Upvote 0
Do không đọc được các tiêu đề nên viết theo ý hiểu (Mục tiêu ở sheet tổng họp họp nếu trùng nhau thì số liệu được công dồn ( lấy trường 1,2,3,4 làm khóa chính ), nên tôi sửa lại code của bạn như sau, hy vọng là đúng ý, và nếu có sai thì chắc bạn tự sửa được.
Mã:
Sub Thongke()
Dim Dic As Object
Dim Arr_N(), Arr_M(), Res(), Rng_D As Range
Dim Dcuoi As Long, Dcuoi2&
Dim i As Long, j As Long, k As Long, t&, tt&

Dcuoi = Sheet1.Range("A10000").End(xlUp).Row
Arr_N = Sheet1.Range("A3:U" & Dcuoi).Value

Dcuoi2 = Sheet2.Range("A10000").End(xlUp).Row
Arr_M = Sheet2.Range("A4:L" & Dcuoi2).Value
Set Dic = CreateObject("Scripting.Dictionary")
ReDim Res(1 To UBound(Arr_N) + UBound(Arr_M), 1 To 27)

For i = 1 To UBound(Arr_N, 1)
Key = Arr_N(i, 1) & "#" & Arr_N(i, 2) & "#" & Arr_N(i, 3) & "#" & Arr_N(i, 4)
    If Not Dic.Exists(Key) Then
        k = k + 1
        Dic.Add (Key), k
        For j = 1 To 21
            Res(k, j) = Arr_N(i, j)
        Next j
    Else
        t = Dic.Item(Key)
            For j = 6 To 21
                Res(t, j) = Res(t, j) + Arr_N(i, j)
            Next j
    End If
Next

For i = 1 To UBound(Arr_M, 1)
    Key = Arr_M(i, 1) & "#" & Arr_M(i, 2) & "#" & Trim(Arr_M(i, 3)) & "#" & Arr_M(i, 4)

    If Not Dic.Exists(Key) Then
        k = k + 1
        Dic.Add (Key), k
        For j = 1 To 4
            Res(k, j) = Arr_M(i, j)
        Next j
        For j = 7 To 12
            Res(k, j + 15) = Arr_M(i, j)
        Next j
    Else
        tt = Dic.Item(Key)
        For j = 7 To 12
            Res(tt, j + 15) = Res(tt, j + 15) + Arr_M(i, j)
        Next j
    End If
Next
If k Then
    Sheet3.Range("A2:AA100000").ClearContents
    Sheet3.Range("A2").Resize(k, 27) = Res
End If
    Set Dic = Nothing
End Sub
Cám ơn bác .
Hình như hàm trim hoạt động không hiệu quả. Nên vẫn còn các dòng chưa được ccoojng dồn . hình .
Bác giúp em với...
1655566648543.png
Bài đã được tự động gộp:

Cám ơn bác .
Hình như hàm trim hoạt động không hiệu quả. Nên vẫn còn các dòng chưa được ccoojng dồn . hình .
Bác giúp em với...
1655566648543.png
Ở Sheet số 2 em dùng hàm trim cột số 3 & dán lại . Sau đó chạy code cho ra kết quả đúng. . Vấn đề là em không hiểu sao hàm trim trong code lại không hiệu quả. Nên cho kết quả chưa chính xác ạ.
Mong bác giúp em
 
Lần chỉnh sửa cuối:
Upvote 0
Mình đã tìm ra vấn đề. Thay Trim thành Application.Trim
Code đã chạy hoàn chỉnh.
Cám ơn Anh @HUONGHCKT rất nhiều.

For i = 1 To UBound(Arr_M, 1)
Key = Arr_M(i, 1) & "#" & Arr_M(i, 2) & "#" & Application.Trim(Arr_M(i, 3)) & "#" & Arr_M(i, 4)
 
Upvote 0
Bác @HUONGHCKT giúp em thêm chút nữa .
Nêu file thống kê e muốn thêm 3 cột . Thì code file thêm như thế nào.
A = sum ( F: U )
B = sum ( Ư : AB )
C = A + B
1655619754622.png
 
Upvote 0
Bác @HUONGHCKT giúp em thêm chút nữa .
Nêu file thống kê e muốn thêm 3 cột . Thì code file thêm như thế nào.
A = sum ( F: U )
B = sum ( Ư : AB )
C = A + B
View attachment 277555
Bạn thay code này vào code cũ:
Mã:
Sub Thongke()
Dim Dic As Object
Dim Arr_N(), Arr_M(), Res(), Rng_D As Range
Dim Dcuoi As Long, Dcuoi2&, Tong1&, Tong2&, Tong3&
Dim i As Long, j As Long, k As Long, t&, tt&

Dcuoi = Sheet1.Range("A10000").End(xlUp).Row
Arr_N = Sheet1.Range("A3:U" & Dcuoi).Value

Dcuoi2 = Sheet2.Range("A10000").End(xlUp).Row
Arr_M = Sheet2.Range("A4:L" & Dcuoi2).Value
Set Dic = CreateObject("Scripting.Dictionary")
ReDim Res(1 To UBound(Arr_N) + UBound(Arr_M), 1 To 30)

For i = 1 To UBound(Arr_N, 1)
Tong1 = 0: Tong2 = 0: Tong3 = 0
Key = Arr_N(i, 1) & "#" & Arr_N(i, 2) & "#" & Arr_N(i, 3) & "#" & Arr_N(i, 4)
    If Not Dic.Exists(Key) Then
        k = k + 1
        Dic.Add (Key), k
        For j = 1 To 21
            Res(k, j) = Arr_N(i, j)
           If j > 5 Then Tong1 = Tong1 + Arr_N(i, j) ': Tong2 = Tong2 + Arr_N(i, j)
        Next j
        Res(k, 22) = Tong1
        Res(k, 29) = Tong2
        Res(k, 30) = Tong1 + Tong2
    Else
        t = Dic.Item(Key)
            For j = 6 To 21
                Res(t, j) = Res(t, j) + Arr_N(i, j)
                Tong1 = Tong1 + Arr_N(i, j)
            Next j
        Res(t, 22) = Res(t, 22) + Tong1
        Res(t, 29) = Res(t, 29) + Tong2
        Res(t, 30) = Res(t, 30) + Tong1 + Tong2
    End If
Next

For i = 1 To UBound(Arr_M, 1)
Tong1 = 0: Tong2 = 0: Tong3 = 0
    Key = Arr_M(i, 1) & "#" & Arr_M(i, 2) & "#" & Trim(Arr_M(i, 3)) & "#" & Arr_M(i, 4)

    If Not Dic.Exists(Key) Then
        k = k + 1
        Dic.Add (Key), k
        For j = 1 To 4
            Res(k, j) = Arr_M(i, j)
        Next j
        For j = 7 To 12
            Res(k, j + 16) = Arr_M(i, j)
            Tong2 = Tong2 + Arr_M(i, j)
        Next j
            Res(k, 29) = Tong2
            Res(k, 30) = Tong1 + Tong2
        
    Else
        tt = Dic.Item(Key)
        For j = 7 To 12
            Res(tt, j + 16) = Res(tt, j + 16) + Arr_M(i, j)
            Tong2 = Tong2 + Arr_M(i, j)
        Next j
            Res(tt, 29) = Res(tt, 29) + Tong2
            Res(tt, 30) = Res(tt, 30) + Tong1 + Tong2
    End If
Next
If k Then
    Sheet3.Range("A2:AA100000").ClearContents
    Sheet3.Range("A2").Resize(k, 30) = Res
End If
    Set Dic = Nothing
    MsgBox "Done"
End Sub
 
Upvote 0
Cám ơn Bác . @HUONGHCKT nhiều lắm .
Các số tổng đều là số nguyên dương. không có số lẽ . Trong khi chi tiết có số lẽ.
Nên kết quả cộng tay so lại là gần đúng, chứ không chính xác.
Em chưa hiểu lắm . hic
 
Upvote 0
Cám ơn Bác . @HUONGHCKT nhiều lắm .
Em đã khai báo lại biến .
Kết quả ra OK rồi bác ơi !


Sub Thongke()
Dim Dic As Object
Dim Arr_N(), Arr_M(), Res(), Rng_D As Range
Dim Dcuoi As Long, Dcuoi2&
Dim Tong1 As Double, Tong2&, Tong3&
Dim i As Long, j As Long, k As Long, t&, tt&
 
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn Bác . @HUONGHCKT nhiều lắm .
Em đã khai báo lại biến .
Kết quả ra OK rồi bác ơi !


Sub Thongke()
Dim Dic As Object
Dim Arr_N(), Arr_M(), Res(), Rng_D As Range
Dim Dcuoi As Long, Dcuoi2&
Dim Tong1 As Double, Tong2&, Tong3&
Dim i As Long, j As Long, k As Long, t&, tt&
Sao bạn không để Tong1 là varial tức là chỉ cần khai báo L Tong1, Tong2, Tong3
 
Upvote 0
Bác @HUONGHCKT cho em hỏi hàm bên dưới trong VBA như thế nào .
Mong bác giúp em

=IF(ISNA(VLOOKUP(B6,CBD!$D$3:$H$99,5,0)),C6,VLOOKUP(B6,CBD!$D$3:$H$99,5,0))
 
Upvote 0
Rất dễ. Nhưng chỉnh các tiếng Tây trong các bài trước đi rồi tôi mới nhúng tay vào.

Lỳ thì cứ đợi người kia giúp cho.
 
Upvote 0
Bác @HUONGHCKT cho em hỏi hàm bên dưới trong VBA như thế nào .
Mong bác giúp em

=IF(ISNA(VLOOKUP(B6,CBD!$D$3:$H$99,5,0)),C6,VLOOKUP(B6,CBD!$D$3:$H$99,5,0))
Tạm hiểu cái hàm của bạn là thế này: If(Nếu)hàm Vlookup(....)Không lỗi(isNa) và có kết quả, thì = C6, còn không thì =kết quả của Hàm Vlookup(...). vậy thì trong VBA ta phải...Có file mới hiểu và làm được
 
Upvote 0
Tạm hiểu cái hàm của bạn là thế này: If(Nếu)hàm Vlookup(....)Không lỗi(isNa) và có kết quả, thì = C6, còn không thì =kết quả của Hàm Vlookup(...). vậy thì trong VBA ta phải...Có file mới hiểu và làm được
Tạm hiểu hay hiểu hết gì cũng vậy thôi.
Hồi nào tới giờ bạn có được bao nhiêu dịp một lần trả lời mà vừa ý thân chủ?

Bên làm thì cật lực mà bên nhờ thì nhỏ giọt.
 
Upvote 0
Tạm hiểu cái hàm của bạn là thế này: If(Nếu)hàm Vlookup(....)Không lỗi(isNa) và có kết quả, thì = C6, còn không thì =kết quả của Hàm Vlookup(...). vậy thì trong VBA ta phải...Có file mới hiểu và làm được



Dạ cám ơn bác @HUONGHCKT em đã viết được rồi ạ
kq1(a, 2) = Application.VLookup(arrksoko(i, 1), Sheets("CBD").Range("D4:H99"), 4, False)
If IsError(kq1(a, 2)) Then
kq1(a, 2) = arrksoko(i, 1)
End If
 
Upvote 0
Tạm hiểu hay hiểu hết gì cũng vậy thôi.
Hồi nào tới giờ bạn có được bao nhiêu dịp một lần trả lời mà vừa ý thân chủ?

Bên làm thì cật lực mà bên nhờ thì nhỏ giọt.
Cảm ơn Anh đã xem bài : Tôi còn thấy thế này nữa (cái này cũng đã nhiều người nói rồi) đó là đã đăng bài nhỏ giọt, dữ liệu thì lung tung (không chuẩn, sh thì kết cấu không có lô gic..) nhưng khi trả lời thì nhận được phản hồi là :code chạy không đúng...(gần như mắng người giúp) và không có một lời cảm ơn (kể cả những bài đã đúng ý định cũng không phản hồi , không có 1 lời cảm ơn người giúp) trong khi người giúp chỉ vì 1 câu code ra sai mà phải mò mẫm tìm từng tý 1 xem sai ở đâu (mà thực ra sai là do dữ liệu của chủ thớt không đồng nhất chứ không phải do code).
Thật đáng buồn cho văn hóa ứng xử ở một số (nhỏ) người đăng bài tìm kiếm sự hỗ trợ tự các thành viên của diễn đàn.
 
Upvote 0
Web KT

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

Back
Top Bottom