Option Explicit
Sub gop()
Dim i&, lr&, dic As Object, key, rng, Sh As Worksheet
Set dic = CreateObject("scripting.dictionary")
For Each Sh In Worksheets
If Sh.Name <> "tong hop" Then
lr = Sh.Range("B" & Rows.Count).End(xlUp).Row
rng = Sh.Range("B6:D" & lr).Value
For i = 1 To lr - 5
If Not IsEmpty(rng(i, 1)) Then
If Not dic.exists(rng(i, 1)) Then
dic.Add rng(i, 1), rng(i, 2) & "|" & rng(i, 3)
Else
dic(rng(i, 1)) = (rng(i, 2) + Split(dic(rng(i, 1)), "|")(0)) & _
"|" & (rng(i, 3) + Split(dic(rng(i, 1)), "|")(1))
End If
End If
Next
End If
Next
i = 0
With Worksheets("tong hop")
.Range("E11").Resize(1000, 3).ClearContents
For Each key In dic.keys
i = i + 1
.Range("E" & i + 10).Value = key
.Range("F" & i + 10).Value = Split(dic(key), "|")(0)
.Range("G" & i + 10).Value = Split(dic(key), "|")(1)
Debug.Print key, dic(key), Len(key)
Next
End With
Set dic = Nothing
MsgBox "xong"
End Sub
Sửa sheets Tổng hợp thành Tong hop và chạy code xem.
Sub gop()
Dim i As Long, lr As Long, dic As Object, a As Long
Dim arr, kq(1 To 1000, 1 To 3), dk As String
Dim Sh As Worksheet, rng As Range
Set dic = CreateObject("scripting.dictionary")
For Each Sh In Worksheets
If Sh.Name <> "Tong hop" Then
With Sh
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr > 5 Then
arr = .Range("B6:D" & lr).Value
For i = 1 To UBound(arr)
dk = arr(i, 1)
If Len(dk) Then
If Not dic.exists(dk) Then
a = a + 1
dic.Add dk, a
kq(a, 1) = dk
kq(a, 2) = arr(i, 2)
kq(a, 3) = arr(i, 3)
Else
kq(dic.Item(dk), 3) = kq(dic.Item(dk), 3) + arr(i, 3)
End If
End If
Next i
End If
End With
End If
Next Sh
With Sheets("tong hop")
.Range("E11:G10000").ClearContents
If a Then
.Range("E11:G11").Resize(a).Value = kq
.Range("E11:G11").Resize(a).Borders.LineStyle = 1
End If
End With
Set dic = Nothing
MsgBox "xong"
End Subdạ em làm theo a được rồi ạ. E cảm ơn a nhiều ạ
dạ em làm theo a được rồi ạ. code chạy ok lắm ạ
