Sumproduct bằng VBA (1 người xem)

  • Thread starter Thread starter stao
  • Ngày gửi Ngày gửi
Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
S

stao

Thành viên hoạt động
Tham gia
29/7/08
Bài viết
113
Được thích
26
Chào các Bác,

Mình có danh mục cần thống kê khoảng 200 mã và dùng Sumproduct cho 8 cột nên file khá chậm.
Qua diễn đàn mình có tìm hiểu được cách VBA cho Sumproduct nhưng còn một số giới hạn về kiến thức nên không hoàn thiện được.

- Điều kiện có phân biệt chữ thường, chữ hoa
- Cách trình bày kết quả như Bảng 2

Rất mong được các Bác hỗ trợ trích báo cáo như Bảng 2 ở sheet BC đính kèm (dữ liệu này mình đã tóm tắt để dễ kiểm tra code)


Cảm ơn các Bác rất nhiều.
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Bổ sung nếu Count thì:
Mã: 
        If Not Dic.exists(Tem) Then
            Dic.Add Tem, 1
        Else
            Dic.Item(Tem) = Dic.Item(Tem) + 1
        End If

Còn các vấn đề khác thì chưa nghĩ ra được.
 
Upvote 0
stao đã viết:
Chào các Bác,

Mình có danh mục cần thống kê khoảng 200 mã và dùng Sumproduct cho 8 cột nên file khá chậm.
Qua diễn đàn mình có tìm hiểu được cách VBA cho Sumproduct nhưng còn một số giới hạn về kiến thức nên không hoàn thiện được.

- Điều kiện có phân biệt chữ thường, chữ hoa
- Cách trình bày kết quả như Bảng 2

Rất mong được các Bác hỗ trợ trích báo cáo như Bảng 2 ở sheet BC đính kèm (dữ liệu này mình đã tóm tắt để dễ kiểm tra code)


Cảm ơn các Bác rất nhiều.
Nhấp chuột vào đây để mở rộng...
Bạn xem file, hên xui!
 

File đính kèm

Upvote 0
stao đã viết:
Chào các Bác,

Mình có danh mục cần thống kê khoảng 200 mã và dùng Sumproduct cho 8 cột nên file khá chậm.
Qua diễn đàn mình có tìm hiểu được cách VBA cho Sumproduct nhưng còn một số giới hạn về kiến thức nên không hoàn thiện được.

- Điều kiện có phân biệt chữ thường, chữ hoa
- Cách trình bày kết quả như Bảng 2

Rất mong được các Bác hỗ trợ trích báo cáo như Bảng 2 ở sheet BC đính kèm (dữ liệu này mình đã tóm tắt để dễ kiểm tra code)


Cảm ơn các Bác rất nhiều.
Nhấp chuột vào đây để mở rộng...
Thiết kế lại mẩu báo cáo hợp lý hơn
Mã: 
Public Sub Baocaobang2()
  Dim Dic As Object, sArr(), TypeArr(), dArr(), ResA(), ResH()
  Dim Key As String, TypeStr As String
  Dim i As Long, ik As Long, k1 As Long, k2 As Long, sRow As Long, Col As Byte
  Const strA = "A"
  Const strH = "H"
  Const strO = "Other"
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("Data")
    sRow = .Range("A" & Rows.Count).End(xlUp).Row ' dòng cuoi
    If sRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub 'kiem tra du lieu
    sArr = .Range("B4:E" & sRow).Value 'mang du lieu nguon
  End With
  sRow = UBound(sArr, 1)
  ReDim ResA(1 To sRow, 1 To 5)
  ReDim ResH(1 To sRow, 1 To 5)
  For i = 1 To sRow
    'set Type A
    Key = sArr(i, 1) & "#" & strA
    If Not Dic.exists(Key) Then
      k1 = k1 + 1 'dong ket qua
      If k1 = 1 Then
        ResA(1, 2) = strA: ResA(1, 3) = strA
        ResA(1, 4) = strO: ResA(1, 5) = strO
        k1 = k1 + 1 'dong ket qua
      End If
      Dic.Add Key, k1
      ResA(k1, 1) = sArr(i, 1)
    End If
    ik = Dic.Item(Key) 'dong ket qua
    If UCase(sArr(i, 3)) = strA Then Col = 2 Else Col = 4 'tinh cot
    ResA(ik, Col) = ResA(ik, Col) + 1 'Count
    ResA(ik, Col + 1) = ResA(ik, Col + 1) + sArr(i, 4) 'Sum
    'set Type H
    Key = sArr(i, 1) & "#" & strH
    If Not Dic.exists(Key) Then
      k2 = k2 + 1 'dong ket qua
      If k2 = 1 Then
        ResH(1, 2) = strH: ResH(1, 3) = strH
        ResH(1, 4) = strO: ResH(1, 5) = strO
        k2 = k2 + 1 'dong ket qua
      End If
      Dic.Add Key, k2
      ResH(k2, 1) = sArr(i, 1)
    End If
    ik = Dic.Item(Key) 'dong ket qua
    If UCase(sArr(i, 3)) = strH Then Col = 2 Else Col = 4 'tinh cot
    ResH(ik, Col) = ResH(ik, Col) + 1 'Count
    ResH(ik, Col + 1) = ResH(ik, Col + 1) + sArr(i, 4) 'Sum
  Next i
With Sheets("BC")
  sRow = .Range("A" & Rows.Count).End(xlUp).Row  ' dòng cuoi
  If sRow > 13 Then .Range("A14:E" & sRow).Clear 'Xoa ket qua truoc
  .Range("A14:E14").Resize(k1) = ResA
  sRow = .Range("A" & Rows.Count).End(xlUp).Row + 1 ' dòng sau dong cuoi
  .Range("A" & sRow).Resize(k2, 5) = ResH
  sRow = .Range("A" & Rows.Count).End(xlUp).Row  ' dòng cuoi
  .Range("A14:E" & sRow).Borders.LineStyle = 1
End With
Set Dic = Nothing
End Sub
 

File đính kèm

Upvote 0
Ba Tê đã viết:
Bạn xem file, hên xui!
Nhấp chuột vào đây để mở rộng...
Cảm ơn Bác nhiều.
Cho em hỏi thêm các dòng code sau nếu chạy vòng lặp (vì dòng báo cáo sẽ nhiều hơn 2) thì làm thế nào cho tổng quát:

Mã: 
    ReDim dArr(1 To 2, 1 To 4)
    Dic.Item(.Range("A15").Value) = 1
    Dic.Item(.Range("A16").Value) = 2
 
Upvote 0
HieuCD đã viết:
Thiết kế lại mẩu báo cáo hợp lý hơn
Mã: 
Public Sub Baocaobang2()
  Dim Dic As Object, sArr(), TypeArr(), dArr(), ResA(), ResH()
  Dim Key As String, TypeStr As String
  Dim i As Long, ik As Long, k1 As Long, k2 As Long, sRow As Long, Col As Byte
  Const strA = "A"
  Const strH = "H"
  Const strO = "Other"
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("Data")
    sRow = .Range("A" & Rows.Count).End(xlUp).Row ' dòng cuoi
    If sRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub 'kiem tra du lieu
    sArr = .Range("B4:E" & sRow).Value 'mang du lieu nguon
  End With
  sRow = UBound(sArr, 1)
  ReDim ResA(1 To sRow, 1 To 5)
  ReDim ResH(1 To sRow, 1 To 5)
  For i = 1 To sRow
    'set Type A
    Key = sArr(i, 1) & "#" & strA
    If Not Dic.exists(Key) Then
      k1 = k1 + 1 'dong ket qua
      If k1 = 1 Then
        ResA(1, 2) = strA: ResA(1, 3) = strA
        ResA(1, 4) = strO: ResA(1, 5) = strO
        k1 = k1 + 1 'dong ket qua
      End If
      Dic.Add Key, k1
      ResA(k1, 1) = sArr(i, 1)
    End If
    ik = Dic.Item(Key) 'dong ket qua
    If UCase(sArr(i, 3)) = strA Then Col = 2 Else Col = 4 'tinh cot
    ResA(ik, Col) = ResA(ik, Col) + 1 'Count
    ResA(ik, Col + 1) = ResA(ik, Col + 1) + sArr(i, 4) 'Sum
    'set Type H
    Key = sArr(i, 1) & "#" & strH
    If Not Dic.exists(Key) Then
      k2 = k2 + 1 'dong ket qua
      If k2 = 1 Then
        ResH(1, 2) = strH: ResH(1, 3) = strH
        ResH(1, 4) = strO: ResH(1, 5) = strO
        k2 = k2 + 1 'dong ket qua
      End If
      Dic.Add Key, k2
      ResH(k2, 1) = sArr(i, 1)
    End If
    ik = Dic.Item(Key) 'dong ket qua
    If UCase(sArr(i, 3)) = strH Then Col = 2 Else Col = 4 'tinh cot
    ResH(ik, Col) = ResH(ik, Col) + 1 'Count
    ResH(ik, Col + 1) = ResH(ik, Col + 1) + sArr(i, 4) 'Sum
  Next i
With Sheets("BC")
  sRow = .Range("A" & Rows.Count).End(xlUp).Row  ' dòng cuoi
  If sRow > 13 Then .Range("A14:E" & sRow).Clear 'Xoa ket qua truoc
  .Range("A14:E14").Resize(k1) = ResA
  sRow = .Range("A" & Rows.Count).End(xlUp).Row + 1 ' dòng sau dong cuoi
  .Range("A" & sRow).Resize(k2, 5) = ResH
  sRow = .Range("A" & Rows.Count).End(xlUp).Row  ' dòng cuoi
  .Range("A14:E" & sRow).Borders.LineStyle = 1
End With
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Rất cảm ơn Bác. Bác thiệt là tỉ mỉ vì có ghi chú nên rất dễ hiểu.
Nếu dưới mỗi dòng tiêu đề kết quả của phần A hay H có thêm dòng Sum của mỗi loại thì thêm code thế nào Bác?
 
Upvote 0
stao đã viết:
Cảm ơn Bác nhiều.
Cho em hỏi thêm các dòng code sau nếu chạy vòng lặp (vì dòng báo cáo sẽ nhiều hơn 2) thì làm thế nào cho tổng quát:

Mã: 
    ReDim dArr(1 To 2, 1 To 4)
    Dic.Item(.Range("A15").Value) = 1
    Dic.Item(.Range("A16").Value) = 2
Nhấp chuột vào đây để mở rộng...
Lúc nào cũng phải hỏi thêm vì ban đầu không biết trước mình muốn gì.
Dòng báo cáo nhiều hơn thì sao biết từng bảng bắt đầu từ đâu?
Để 2 bảng ngang nhau vậy.
 

File đính kèm

Upvote 0
stao đã viết:
Rất cảm ơn Bác. Bác thiệt là tỉ mỉ vì có ghi chú nên rất dễ hiểu.
Nếu dưới mỗi dòng tiêu đề kết quả của phần A hay H có thêm dòng Sum của mỗi loại thì thêm code thế nào Bác?
Nhấp chuột vào đây để mở rộng...
Mã: 
Public Sub Baocaobang2()
  Dim Dic As Object, sArr(), TypeArr(), dArr(), ResA(), ResH()
  Dim Key As String, TypeStr As String
  Dim i As Long, ik As Long, k1 As Long, k2 As Long, sRow As Long, Col As Byte
  Const strA = "A"
  Const strH = "H"
  Const strO = "Other"
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("Data")
    sRow = .Range("A" & Rows.Count).End(xlUp).Row ' dòng cuoi
    If sRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub 'kiem tra du lieu
    sArr = .Range("B4:E" & sRow).Value 'mang du lieu nguon
  End With
  sRow = UBound(sArr, 1)
  ReDim ResA(1 To sRow, 1 To 5)
  ReDim ResH(1 To sRow, 1 To 5)
  For i = 1 To sRow
    'set Type A
    Key = sArr(i, 1) & "#" & strA
    If Not Dic.exists(Key) Then
      k1 = k1 + 1 'dong ket qua
      If k1 = 1 Then
        ResA(1, 2) = strA: ResA(1, 3) = strA
        ResA(1, 4) = strO: ResA(1, 5) = strO
        k1 = k1 + 1 'dong ket qua
      End If
      Dic.Add Key, k1
      ResA(k1, 1) = sArr(i, 1)
    End If
    ik = Dic.Item(Key) 'dong ket qua
    If UCase(sArr(i, 3)) = strA Then Col = 2 Else Col = 4 'tinh cot
    ResA(ik, Col) = ResA(ik, Col) + 1 'Count
    ResA(ik, Col + 1) = ResA(ik, Col + 1) + sArr(i, 4) 'Sum
    ResA(sRow, Col) = ResA(sRow, Col) + 1 'Tong Count
    ResA(sRow, Col + 1) = ResA(sRow, Col + 1) + sArr(i, 4) 'Tong Sum
    'set Type H
    Key = sArr(i, 1) & "#" & strH
    If Not Dic.exists(Key) Then
      k2 = k2 + 1 'dong ket qua
      If k2 = 1 Then
        ResH(1, 2) = strH: ResH(1, 3) = strH
        ResH(1, 4) = strO: ResH(1, 5) = strO
        k2 = k2 + 1 'dong ket qua
      End If
      Dic.Add Key, k2
      ResH(k2, 1) = sArr(i, 1)
    End If
    ik = Dic.Item(Key) 'dong ket qua
    If UCase(sArr(i, 3)) = strH Then Col = 2 Else Col = 4 'tinh cot
    ResH(ik, Col) = ResH(ik, Col) + 1 'Count
    ResH(ik, Col + 1) = ResH(ik, Col + 1) + sArr(i, 4) 'Sum
    ResH(sRow, Col) = ResH(sRow, Col) + 1 'Tong Count
    ResH(sRow, Col + 1) = ResH(sRow, Col + 1) + sArr(i, 4) 'Tong Sum
  Next i
  k1 = k1 + 1:  ResA(k1, 1) = "Tong cong" 'dòng Tong cong Type A
  k2 = k2 + 1:  ResH(k2, 1) = "Tong cong" 'dòng Tong cong Type H
  For Col = 2 To 5
    If ResA(sRow, Col) > 0 Then ResA(k1, Col) = ResA(sRow, Col) 'dòng Tong cong Type A
    If ResH(sRow, Col) > 0 Then ResH(k2, Col) = ResH(sRow, Col) 'dòng Tong cong Type A
  Next Col
With Sheets("BC")
  sRow = .Range("A" & Rows.Count).End(xlUp).Row  ' dòng cuoi
  If sRow > 13 Then .Range("A14:E" & sRow).Clear 'Xoa ket qua truoc
  .Range("A14:E14").Resize(k1) = ResA
  sRow = .Range("A" & Rows.Count).End(xlUp).Row + 1 ' dòng sau dong cuoi
  .Range("A" & sRow).Resize(k2, 5) = ResH
  sRow = .Range("A" & Rows.Count).End(xlUp).Row  ' dòng cuoi
  .Range("A14:E" & sRow).Borders.LineStyle = 1
End With
Set Dic = Nothing
End Sub
 
Upvote 0
HieuCD đã viết:
Mã: 
Public Sub Baocaobang2()
  Dim Dic As Object, sArr(), TypeArr(), dArr(), ResA(), ResH()
  Dim Key As String, TypeStr As String
  Dim i As Long, ik As Long, k1 As Long, k2 As Long, sRow As Long, Col As Byte
  Const strA = "A"
  Const strH = "H"
  Const strO = "Other"
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("Data")
    sRow = .Range("A" & Rows.Count).End(xlUp).Row ' dòng cuoi
    If sRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub 'kiem tra du lieu
    sArr = .Range("B4:E" & sRow).Value 'mang du lieu nguon
  End With
  sRow = UBound(sArr, 1)
  ReDim ResA(1 To sRow, 1 To 5)
  ReDim ResH(1 To sRow, 1 To 5)
  For i = 1 To sRow
    'set Type A
    Key = sArr(i, 1) & "#" & strA
    If Not Dic.exists(Key) Then
      k1 = k1 + 1 'dong ket qua
      If k1 = 1 Then
        ResA(1, 2) = strA: ResA(1, 3) = strA
        ResA(1, 4) = strO: ResA(1, 5) = strO
        k1 = k1 + 1 'dong ket qua
      End If
      Dic.Add Key, k1
      ResA(k1, 1) = sArr(i, 1)
    End If
    ik = Dic.Item(Key) 'dong ket qua
    If UCase(sArr(i, 3)) = strA Then Col = 2 Else Col = 4 'tinh cot
    ResA(ik, Col) = ResA(ik, Col) + 1 'Count
    ResA(ik, Col + 1) = ResA(ik, Col + 1) + sArr(i, 4) 'Sum
    ResA(sRow, Col) = ResA(sRow, Col) + 1 'Tong Count
    ResA(sRow, Col + 1) = ResA(sRow, Col + 1) + sArr(i, 4) 'Tong Sum
    'set Type H
    Key = sArr(i, 1) & "#" & strH
    If Not Dic.exists(Key) Then
      k2 = k2 + 1 'dong ket qua
      If k2 = 1 Then
        ResH(1, 2) = strH: ResH(1, 3) = strH
        ResH(1, 4) = strO: ResH(1, 5) = strO
        k2 = k2 + 1 'dong ket qua
      End If
      Dic.Add Key, k2
      ResH(k2, 1) = sArr(i, 1)
    End If
    ik = Dic.Item(Key) 'dong ket qua
    If UCase(sArr(i, 3)) = strH Then Col = 2 Else Col = 4 'tinh cot
    ResH(ik, Col) = ResH(ik, Col) + 1 'Count
    ResH(ik, Col + 1) = ResH(ik, Col + 1) + sArr(i, 4) 'Sum
    ResH(sRow, Col) = ResH(sRow, Col) + 1 'Tong Count
    ResH(sRow, Col + 1) = ResH(sRow, Col + 1) + sArr(i, 4) 'Tong Sum
  Next i
  k1 = k1 + 1:  ResA(k1, 1) = "Tong cong" 'dòng Tong cong Type A
  k2 = k2 + 1:  ResH(k2, 1) = "Tong cong" 'dòng Tong cong Type H
  For Col = 2 To 5
    If ResA(sRow, Col) > 0 Then ResA(k1, Col) = ResA(sRow, Col) 'dòng Tong cong Type A
    If ResH(sRow, Col) > 0 Then ResH(k2, Col) = ResH(sRow, Col) 'dòng Tong cong Type A
  Next Col
With Sheets("BC")
  sRow = .Range("A" & Rows.Count).End(xlUp).Row  ' dòng cuoi
  If sRow > 13 Then .Range("A14:E" & sRow).Clear 'Xoa ket qua truoc
  .Range("A14:E14").Resize(k1) = ResA
  sRow = .Range("A" & Rows.Count).End(xlUp).Row + 1 ' dòng sau dong cuoi
  .Range("A" & sRow).Resize(k2, 5) = ResH
  sRow = .Range("A" & Rows.Count).End(xlUp).Row  ' dòng cuoi
  .Range("A14:E" & sRow).Borders.LineStyle = 1
End With
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn Bác. Em đang mày mò đưa dòng tổng về đầu nhóm Type theo code sau:
Mã: 
  ResA(2, 1) = "Tong cong" 'dòng Tong cong Type A
  ResH(2, 1) = "Tong cong" 'dòng Tong cong Type H
  For Col = 2 To 5
    If ResA(sRow, Col) > 0 Then ResA(2, Col) = ResA(sRow, Col) 'dòng Tong cong Type A
    If ResH(sRow, Col) > 0 Then ResH(2, Col) = ResH(sRow, Col) 'dòng Tong cong Type H
  Next Col

Tuy nhiên vướng cái là nó làm mất dòng đầu là H12 ở mỗi nhóm. Chưa rõ chỉnh code thế nào.

Câu hỏi thêm nữa là, trường hợp dòng tổng ở đầu mỗi nhóm, cần thêm 1 nút lệnh để nhập công thức SUM ở mỗi dòng tổng đó (kết quả cột B là SUM(B16:B19), tương ứng cột C,D,E). Điều kiện là không biết trước được số dòng (ví dụ số 16, 19) mỗi nhóm.

Nhờ các Bác giúp em.
 
Upvote 0
stao đã viết:
Cảm ơn Bác. Em đang mày mò đưa dòng tổng về đầu nhóm Type theo code sau:
Mã: 
  ResA(2, 1) = "Tong cong" 'dòng Tong cong Type A
  ResH(2, 1) = "Tong cong" 'dòng Tong cong Type H
  For Col = 2 To 5
    If ResA(sRow, Col) > 0 Then ResA(2, Col) = ResA(sRow, Col) 'dòng Tong cong Type A
    If ResH(sRow, Col) > 0 Then ResH(2, Col) = ResH(sRow, Col) 'dòng Tong cong Type H
  Next Col

Tuy nhiên vướng cái là nó làm mất dòng đầu là H12 ở mỗi nhóm. Chưa rõ chỉnh code thế nào.

Câu hỏi thêm nữa là, trường hợp dòng tổng ở đầu mỗi nhóm, cần thêm 1 nút lệnh để nhập công thức SUM ở mỗi dòng tổng đó (kết quả cột B là SUM(B16:B19), tương ứng cột C,D,E). Điều kiện là không biết trước được số dòng (ví dụ số 16, 19) mỗi nhóm.

Nhờ các Bác giúp em.
Nhấp chuột vào đây để mở rộng...
Nếu biết trước thứ tự dòng tổng cộng thì tính trực tiếp không dùng dòng cuối ghi tạm dữ liệu
Mã: 
Public Sub Baocaobang2()
  Dim Dic As Object, sArr(), TypeArr(), dArr(), ResA(), ResH()
  Dim Key As String, TypeStr As String
  Dim i As Long, ik As Long, k1 As Long, k2 As Long, sRow As Long, Col As Byte
  Const strA = "A"
  Const strH = "H"
  Const strO = "Other"
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("Data")
    sRow = .Range("A" & Rows.Count).End(xlUp).Row ' dòng cuoi
    If sRow < 3 Then MsgBox ("Khong co du lieu"): Exit Sub 'kiem tra du lieu
    sArr = .Range("B4:E" & sRow).Value 'mang du lieu nguon
  End With
  sRow = UBound(sArr, 1)
  ReDim ResA(1 To sRow, 1 To 5)
  ReDim ResH(1 To sRow, 1 To 5)
  ResA(2, 1) = "Tong cong" 'dòng Tong cong Type A
  ResH(2, 1) = "Tong cong" 'dòng Tong cong Type H
  For i = 1 To sRow
    'set Type A
    Key = sArr(i, 1) & "#" & strA
    If Not Dic.exists(Key) Then
      k1 = k1 + 1 'dong ket qua
      If k1 = 1 Then
        ResA(1, 2) = strA: ResA(1, 3) = strA
        ResA(1, 4) = strO: ResA(1, 5) = strO
        k1 = k1 + 2 'dong ket qua
      End If
      Dic.Add Key, k1
      ResA(k1, 1) = sArr(i, 1)
    End If
    ik = Dic.Item(Key) 'dong ket qua
    If UCase(sArr(i, 3)) = strA Then Col = 2 Else Col = 4 'tinh cot
    ResA(ik, Col) = ResA(ik, Col) + 1 'Count
    ResA(ik, Col + 1) = ResA(ik, Col + 1) + sArr(i, 4) 'Sum
    ResA(2, Col) = ResA(2, Col) + 1 'Tong Count
    ResA(2, Col + 1) = ResA(2, Col + 1) + sArr(i, 4) 'Tong Sum
    'set Type H
    Key = sArr(i, 1) & "#" & strH
    If Not Dic.exists(Key) Then
      k2 = k2 + 1 'dong ket qua
      If k2 = 1 Then
        ResH(1, 2) = strH: ResH(1, 3) = strH
        ResH(1, 4) = strO: ResH(1, 5) = strO
        k2 = k2 + 2 'dong ket qua
      End If
      Dic.Add Key, k2
      ResH(k2, 1) = sArr(i, 1)
    End If
    ik = Dic.Item(Key) 'dong ket qua
    If UCase(sArr(i, 3)) = strH Then Col = 2 Else Col = 4 'tinh cot
    ResH(ik, Col) = ResH(ik, Col) + 1 'Count
    ResH(ik, Col + 1) = ResH(ik, Col + 1) + sArr(i, 4) 'Sum
    ResH(2, Col) = ResH(2, Col) + 1 'Tong Count
    ResH(2, Col + 1) = ResH(2, Col + 1) + sArr(i, 4) 'Tong Sum
  Next i

  With Sheets("BC")
    sRow = .Range("A" & Rows.Count).End(xlUp).Row  ' dòng cuoi
    If sRow > 13 Then .Range("A14:E" & sRow).Clear 'Xoa ket qua truoc
    .Range("A14:E14").Resize(k1) = ResA
    sRow = .Range("A" & Rows.Count).End(xlUp).Row + 1 ' dòng sau dong cuoi
    .Range("A" & sRow).Resize(k2, 5) = ResH
    sRow = .Range("A" & Rows.Count).End(xlUp).Row  ' dòng cuoi
    .Range("A14:E" & sRow).Borders.LineStyle = 1
  End With
  Set Dic = Nothing
End Sub
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

nghiahandsome1995
  • Question Question
in đậm chuỗi văn bản bằng excel
Trả lời
8
Đọc
186
nghiahandsome1995
nghiahandsome1995
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
Trả lời
2
Đọc
104
PhanTuHuong
PhanTuHuong
Đỗ Tú Anh
♪♫♪ ~ Thư Giãn Với Âm Nhạc ~ ♫♪♫
    • Thích
21 22 23
Trả lời
447
Đọc
11K
Đỗ Tú Anh
Đỗ Tú Anh
S
  • Question Question
Nhờ Mọi người giúp đỡ gộp nhiều dòng thành 1 dòng nhiều cột trong Power Query.
Trả lời
3
Đọc
137
DeTong
D
dangvandang
  • Question Question
Chia sẻ tích hợp trí tuệ nhân tạo (AI) vào excel
    • Thích
Trả lời
8
Đọc
2K
dangvandang
dangvandang
ankhanh2k2
sắp xếp dữ liệu chấm công
    • Buồn
Trả lời
4
Đọc
108
DeTong
D
HeSanbi
  • Question Question
Công cụ tạo và chỉnh sửa Ribbon ngay trên Excel (Bản Việt hóa)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
10
Đọc
6K
HeSanbi
HeSanbi
N
  • Question Question
Xin code link dữ liệu VBA ạ !
Trả lời
1
Đọc
91
BuiQuangThuan
B
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
    • Thích
Trả lời
7
Đọc
443
trung_bhxh
T
toanthinh
Công thức tính tuổi âm lịch
Trả lời
3
Đọc
117
toanthinh
toanthinh
S
Cần hỗ trợ xử lý hiện ngày sản phẩm bằng VBA
Trả lời
0
Đọc
60
sonminhtran
S
GPE-Trợ Lý
[GPE] TALK SHOW EXCEL TRONG SẢN XUẤT
    • Thích
Trả lời
2
Đọc
786
GPE-Trợ Lý
GPE-Trợ Lý
Nguyễn Duy Tuân
Phiên bản mới Add-in A-Tools v10 (2024)
    • Thích
2 3
Trả lời
40
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
T
  • Question Question
Mong mọi người giúp đỡ em trường hợp này với ạ.
Trả lời
1
Đọc
127
thanhduybg92
T
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
    • Thích
Trả lời
1
Đọc
85
vn72259
V
giaiphap
Add-Ins cho Excel 2007 -2016 32bit và 64bit
    • Thích
    • Yêu thích
    • Ngạc nhiên
24 25 26
Trả lời
512
Đọc
192K
vn72259
V
HeSanbi
  • Đã giải quyết
ZaloExcel v2.94: Gửi tin nhắn, hình ảnh, bảng, biểu đồ, tập tin, tạo nhóm, thu thập tin nhắn
    • Thích
    • Cảm ơn
    • Yêu thích
2 3
Trả lời
56
Đọc
15K
HeSanbi
HeSanbi
quyenpv
Hỗ trợ công thức dò tìn Index, Match trong bảng dò tìm kết quả
Trả lời
5
Đọc
130
quyenpv
quyenpv
H
In các trang theo điều kiện
Trả lời
3
Đọc
77
HUONGHCKT
H
L
Viết phần mềm đánh lô bằng Visual Basic (1 người xem)
    • Thích
2 3 4
Trả lời
66
Đọc
104K
VetMini
V
Xem thêm…

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

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW EXCEL TRONG SẢN XUẤT
Back
Top Bottom