Khong dung nhu the nao? cho vi du cu the
Giúp em Code VBA chạy tập hợp tổng số lượng mã hàng theo từng loại hình?
- Thread starter danhculao
- Ngày gửi
Dạ, cho kết quả ở sheet Tong như sau ạ:
| Gói cước | STT | Quận | Loại hình | Số lượng HĐ | 20019030 | 20025279 | 20022152 | 20024516 | 20019586 | 20032853 | 20018431 | 20023533 | 20026837 | 20018166 | 20021317 |
| 1 core(MET) | G-97RG3(CHI) | FC G(CHI) | Day rut(SOI) | GPON Wifi(CHI) | Archer C5(BO) | EPON Wifi(CHI) | G-97D2(CHI) | ONT 1 port 1G(CHI) | FC E(CHI) | Vigor 2925(CAI) | |||||
| PON | 1 | Triển khai mới | 7 | 769 | 7 | 14 | 66 | ||||||||
2 | Chuyển địa điểm | 6 | 78 | 4 | 8 | 36 | |||||||||
3 | Khác | 5 | 15 | 1 | 0 | 45 | |||||||||
| Tong Cong | 862 | 12 | 22 | 147 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | ||||
| Gói cước | STT | Quận | Loại hình | Số lượng HĐ | 20019319 | 20021783 | 20000314 | 20020106 | 20016788 | 20031607 | 20020534 | 20000112 | |||
| AV(SOI) | Nguon HDBox(CAI) | RJ45(CHI) | Remote HDBox(CHI) | HDMI(CAI) | Box 4K(CHI) | HD box Old(CHI) | Cap 5(MET) | ||||||||
| PAYTV | 1 | Khác | 5 | 0 | 5 | 8 | 5 | 5 | 5 | 0 | 50 | ||||
2 | Chuyển địa điểm | 7 | 3 | 7 | 18 | 7 | 4 | 3 | 4 | 30 | |||||
3 | Triển khai mới | 6 | 6 | 6 | 31 | 6 | 0 | 6 | 0 | 60 | |||||
| Tong Cong | 9 | 18 | 57 | 18 | 9 | 14 | 4 | 140 |
Ba Tê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,125
- Được thích
- 17,581
- Giới tính
- Nam
Thử xem file này, dữ liệu lu bu quá nên viết thành 2 Sub.
Chinh lai code
Mã:
Sub TongHop()
Dim sArr(), td(), GoiCuoc, Res(), Res2(), Ma(), sh As Worksheet, Dic As Object, Dic2 As Object, iKey As String
Dim eCol As Long, sCol As Long, eRow As Long, i As Long, j As Long
Dim k As Long, ik As Long, jk As Long, n As Long, q As Long
Set Dic = CreateObject("scripting.dictionary")
Set Dic2 = CreateObject("scripting.dictionary")
With Sheets("MaHang")
eRow = .Range("B" & Rows.Count).End(xlUp).Row
If eRow > 1 Then
sArr = .Range("B2:C" & eRow).Value
For i = 1 To UBound(sArr)
Dic2.Item(sArr(i, 2)) = sArr(i, 1)
Next i
End If
End With
With Sheets("Tong")
td = .Range("A1:E1").Value
eRow = .Range("E" & Rows.Count).End(xlUp).Row
eCol = .UsedRange.Columns.Count
If eRow > 1 Then .Range("A2:A" & eRow).Resize(, 200).Clear
End With
Application.ScreenUpdating = False
GoiCuoc = Array("PON", "PAYTV")
For n = 0 To UBound(GoiCuoc)
sCol = 5: k = 1
ReDim Res(1 To 1000, 1 To sCol)
Res(2, 1) = GoiCuoc(n)
For Each sh In ThisWorkbook.Worksheets
If sh.Name Like "Tab*" Then
eRow = sh.Range("F" & Rows.Count).End(xlUp).Row + 1
If eRow > 2 Then
For i = 2 To eRow - 1
If UCase(sh.Range("A" & i).Value) = GoiCuoc(n) Then
eCol = sh.Cells(i - 1, Columns.Count).End(1).Column
sArr = sh.Range(sh.Cells(i - 1, "A"), sh.Cells(eRow, eCol)).Value
Exit For
End If
Next i
For j = 6 To eCol
iKey = sArr(1, j)
If Dic.exists(iKey) = False Then
sCol = sCol + 1
ReDim Preserve Res(1 To 1000, 1 To sCol)
Res(1, sCol) = iKey
Dic.Add iKey, sCol
ReDim Preserve Res2(1 To 1, 1 To sCol - 5)
Res2(1, sCol - 5) = Dic2.Item(iKey)
End If
Next j
For i = 2 To UBound(sArr)
If Len(sArr(i, 3)) = 0 Then
Exit For
End If
iKey = sArr(i, 4)
If Dic.exists(iKey) = False Then
k = k + 1
Dic.Add iKey, k
Res(k, 2) = k - 1
Res(k, 4) = sArr(i, 4)
End If
ik = Dic.Item(iKey)
Res(ik, 5) = Res(ik, 5) + sArr(i, 5)
For j = 6 To eCol
jk = Dic.Item(sArr(1, j))
If sArr(i, j) > 0 Then
Res(ik, jk) = Res(ik, jk) + sArr(i, j)
End If
Next j
Next i
End If
End If
Next
ik = 1
If k > 1 Then
For i = 2 To k
For j = 6 To eCol
If Res(i, j) > 0 Then
Res(k + 2, j) = Res(k + 2, j) + Res(i, j)
End If
Next j
Next i
With Sheets("Tong")
eRow = .Range("E" & Rows.Count).End(xlUp).Row
If eRow > 2 Then
eRow = eRow + 2
.Range("A" & eRow).Resize(, 5).Value = td
End If
Res(k + 2, 5) = "Tong Cong"
.Range("A" & eRow + 1).Resize(k + 2, sCol).Value = Res
.Range("A" & eRow).Resize(k + 3, sCol).Borders.LineStyle = 1
.Range("F" & eRow).Resize(, sCol - 5).Value = Res2
End With
End If
Dic.RemoveAll
Next n
Application.ScreenUpdating = True
End Sub
Lần chỉnh sửa cuối:
Dạ, sheet Tong kết quả tổng vẫn chưa đúng anh ạ. Do trường hợp Tab2 chỉ có 1 bảng là PON và Tab3 chỉ có 1 bảng là PayTV nên dữ liệu bên sheet Tong link qua không hiểu. Nhờ anh giúp lại em Code với ạ. Em cám ơn!
Lần chỉnh sửa cuối:
Dạ, sheet Tong kết quả vẫn chưa đúng anh ạ, Nhờ anh giúp lại em với ạ
Kết quả đúng như bảng dưới:
| Gói cước | STT | Quận | Loại hình | Số lượng HĐ | 20019030 | 20025279 | 20022152 | 20024516 | 20024739 | |||
| 1 core(MET) | G-97RG3(CHI) | FC G(CHI) | Day rut(SOI) | TL-WR841ND(CHI) | ||||||||
| PON | 1 | Triển khai mới | 5 | 644 | 5 | 10 | 46 | 125 | ||||
2 | Chuyển địa điểm | 4 | 58 | 3 | 6 | 27 | 0 | |||||
3 | Khác | 3 | 15 | 0 | 0 | 27 | 250 | |||||
| Tong Cong | 717 | 8 | 16 | 100 | 375 | |||||||
| Gói cước | STT | Quận | Loại hình | Số lượng HĐ | 20019319 | 20021783 | 20000314 | 20020106 | 20016788 | 20031607 | 20020534 | 20000112 |
| AV(SOI) | Nguon HDBox(CAI) | RJ45(CHI) | Remote HDBox(CHI) | HDMI(CAI) | Box 4K(CHI) | HD box Old(CHI) | Cap 5(MET) | |||||
| PAYTV | 1 | Khác | 5 | 0 | 5 | 8 | 5 | 5 | 5 | 0 | 83 | |
2 | Chuyển địa điểm | 7 | 3 | 7 | 18 | 7 | 4 | 3 | 4 | 30 | ||
3 | Triển khai mới | 6 | 6 | 6 | 31 | 6 | 0 | 6 | 0 | 60 | ||
| Tong Cong | 9 | 18 | 57 | 18 | 9 | 14 | 4 | 173 |
Chỉnh lại
Mã:
Sub TongHop()
Dim sArr(), td(), GoiCuoc, Res(), Res2(), Ma(), sh As Worksheet, Dic As Object, Dic2 As Object, iKey As String
Dim eCol As Long, sCol As Long, eRow As Long, i As Long, j As Long
Dim k As Long, ik As Long, jk As Long, n As Long, q As Long
Set Dic = CreateObject("scripting.dictionary")
Set Dic2 = CreateObject("scripting.dictionary")
With Sheets("MaHang")
eRow = .Range("B" & Rows.Count).End(xlUp).Row
If eRow > 1 Then
sArr = .Range("B2:C" & eRow).Value
For i = 1 To UBound(sArr)
Dic2.Item(sArr(i, 2)) = sArr(i, 1)
Next i
End If
End With
With Sheets("Tong")
td = .Range("A1:E1").Value
eRow = .Range("E" & Rows.Count).End(xlUp).Row
.Range("F1").Resize(, 200).Clear
If eRow > 1 Then .Range("A2:A" & eRow).Resize(, 200).Clear
End With
Application.ScreenUpdating = False
GoiCuoc = Array("PON", "PAYTV")
For n = 0 To UBound(GoiCuoc)
sCol = 5: k = 1
ReDim Res(1 To 1000, 1 To sCol)
Res(2, 1) = GoiCuoc(n)
For Each sh In ThisWorkbook.Worksheets
If sh.Name Like "Tab*" Then
eRow = sh.Range("F" & Rows.Count).End(xlUp).Row + 1
If eRow > 2 Then
For i = 2 To eRow - 1
If UCase(sh.Range("A" & i).Value) = GoiCuoc(n) Then
eCol = sh.Cells(i - 1, Columns.Count).End(1).Column
sArr = sh.Range(sh.Cells(i - 1, "A"), sh.Cells(eRow, eCol)).Value
Exit For
End If
Next i
If i < eRow Then
For j = 6 To eCol
iKey = sArr(1, j)
If Dic.exists(iKey) = False Then
sCol = sCol + 1
ReDim Preserve Res(1 To 1000, 1 To sCol)
Res(1, sCol) = iKey
Dic.Add iKey, sCol
ReDim Preserve Res2(1 To 1, 1 To sCol - 5)
Res2(1, sCol - 5) = Dic2.Item(iKey)
End If
Next j
For i = 2 To UBound(sArr)
If Len(sArr(i, 3)) = 0 Then
Exit For
End If
iKey = sArr(i, 4)
If Dic.exists(iKey) = False Then
k = k + 1
Dic.Add iKey, k
Res(k, 2) = k - 1
Res(k, 4) = sArr(i, 4)
End If
ik = Dic.Item(iKey)
Res(ik, 5) = Res(ik, 5) + sArr(i, 5)
For j = 6 To eCol
jk = Dic.Item(sArr(1, j))
If sArr(i, j) > 0 Then
Res(ik, jk) = Res(ik, jk) + sArr(i, j)
End If
Next j
Next i
End If
End If
End If
Next
ik = 1
If k > 1 Then
For i = 2 To k
For j = 6 To sCol
If Res(i, j) > 0 Then
Res(k + 2, j) = Res(k + 2, j) + Res(i, j)
End If
Next j
Next i
With Sheets("Tong")
eRow = .Range("E" & Rows.Count).End(xlUp).Row
If eRow > 2 Then
eRow = eRow + 2
.Range("A" & eRow).Resize(, 5).Value = td
End If
Res(k + 2, 5) = "Tong Cong"
.Range("A" & eRow + 1).Resize(k + 2, sCol).Value = Res
.Range("A" & eRow).Resize(k + 3, sCol).Borders.LineStyle = 1
.Range("F" & eRow).Resize(, sCol - 5).Value = Res2
End With
End If
Dic.RemoveAll
Next n
Application.ScreenUpdating = True
End SubEm cám ơn nhiều ạ!
