Code VBA - Mảng - Lập báo cáo worst

Liên hệ QC
C

cauthi_toiuu

Thành viên mới
Tham gia
1/5/20
Bài viết
10
Được thích
0
Chào các anh chị trong diễn đàn !
Mình có một vấn đề chưa được giải quyết (khó đối với mình)
Mong các anh chị giúp đỡ
Chi tiết mình mô tả kĩ trong file đính kèm
Mong các anh chị hỗ trợ.
Cảm ơn!
 

File đính kèm

  • Hỏi bài.xlsx
    25.2 KB · Đọc: 75
Sắp xếp theo thời gian sắp xếp theo bầu chọn
cauthi_toiuu đã viết:
Chào các anh chị trong diễn đàn !
Mình có một vấn đề chưa được giải quyết (khó đối với mình)
Mong các anh chị giúp đỡ
Chi tiết mình mô tả kĩ trong file đính kèm
Mong các anh chị hỗ trợ.
Cảm ơn!
Nhấp chuột vào đây để mở rộng...
Chạy code
Mã: 
Sub Worst_Report()
  Dim sArr(), Res(), oSList As Object, oSList2 As Object, S, S2, iItem$
  Dim iDate As Date, sRow&, i&, kCH&, tmp, iK&, k&, r&
 
  iDate = Sheets("Report").Range("C2").Value
  Set oSList = CreateObject("System.Collections.SortedList")
  Set oSList2 = CreateObject("System.Collections.SortedList")
  With Sheets("Data")
    sArr = .Range("B2", .Range("E" & Rows.Count)).Value
  End With
  sRow = UBound(sArr)
  For i = 1 To sRow
    If sArr(i, 1) = iDate Then
      oSList.Item(sArr(i, 2)) = oSList.Item(sArr(i, 2)) + sArr(i, 4)
      oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) = oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) + sArr(i, 4)
    End If
  Next i
  sRow = oSList.Count - 1
  For i = 0 To sRow
    oSList2.Item(oSList.GetByIndex(i)) = oSList2.Item(oSList.GetByIndex(i)) & "," & oSList.GetKey(i)
  Next i
  ReDim Res(1 To 12, 1 To 5)
  sRow = oSList2.Count - 1
  For i = sRow To 0 Step -1
    S = Split(oSList2.GetByIndex(i), ",")
    For r = 1 To UBound(S)
      iItem = S(r)
      If InStr(1, iItem, "#") = 0 Then
        If kCH < 4 Then
          kCH = kCH + 1
          iK = kCH * 3 - 2
          Res(iK, 1) = kCH:          Res(iK, 2) = iItem
          oSList.Item(iItem) = iK
        End If
      Else
        S2 = Split(S(r), "#")
        tmp = S2(0):        iK = oSList.Item(tmp)
        If iK > 0 Then
          Res(iK, 3) = S2(1)
          tmp = S(r):       Res(iK, 4) = oSList.Item(tmp)
          k = ((iK - 1) \ 3) * 3 + 1
          Res(k, 5) = Res(k, 5) + Res(iK, 4)
          If (iK Mod 3) = 0 Then
            tmp = S2(0): oSList.Item(tmp) = 0
          Else
            tmp = S2(0): oSList.Item(tmp) = iK + 1
          End If
        End If
      End If
    Next r
  Next i
  Sheets("Report").Range("A5").Resize(12, 5) = Res
  Set oSList = Nothing: Set oSList2 = Nothing
End Sub
 
Upvote 0
HieuCD đã viết:
Chạy code
Mã: 
Sub Worst_Report()
  Dim sArr(), Res(), oSList As Object, oSList2 As Object, S, S2, iItem$
  Dim iDate As Date, sRow&, i&, kCH&, tmp, iK&, k&, r&

  iDate = Sheets("Report").Range("C2").Value
  Set oSList = CreateObject("System.Collections.SortedList")
  Set oSList2 = CreateObject("System.Collections.SortedList")
  With Sheets("Data")
    sArr = .Range("B2", .Range("E" & Rows.Count)).Value
  End With
  sRow = UBound(sArr)
  For i = 1 To sRow
    If sArr(i, 1) = iDate Then
      oSList.Item(sArr(i, 2)) = oSList.Item(sArr(i, 2)) + sArr(i, 4)
      oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) = oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) + sArr(i, 4)
    End If
  Next i
  sRow = oSList.Count - 1
  For i = 0 To sRow
    oSList2.Item(oSList.GetByIndex(i)) = oSList2.Item(oSList.GetByIndex(i)) & "," & oSList.GetKey(i)
  Next i
  ReDim Res(1 To 12, 1 To 5)
  sRow = oSList2.Count - 1
  For i = sRow To 0 Step -1
    S = Split(oSList2.GetByIndex(i), ",")
    For r = 1 To UBound(S)
      iItem = S(r)
      If InStr(1, iItem, "#") = 0 Then
        If kCH < 4 Then
          kCH = kCH + 1
          iK = kCH * 3 - 2
          Res(iK, 1) = kCH:          Res(iK, 2) = iItem
          oSList.Item(iItem) = iK
        End If
      Else
        S2 = Split(S(r), "#")
        tmp = S2(0):        iK = oSList.Item(tmp)
        If iK > 0 Then
          Res(iK, 3) = S2(1)
          tmp = S(r):       Res(iK, 4) = oSList.Item(tmp)
          k = ((iK - 1) \ 3) * 3 + 1
          Res(k, 5) = Res(k, 5) + Res(iK, 4)
          If (iK Mod 3) = 0 Then
            tmp = S2(0): oSList.Item(tmp) = 0
          Else
            tmp = S2(0): oSList.Item(tmp) = iK + 1
          End If
        End If
      End If
    Next r
  Next i
  Sheets("Report").Range("A5").Resize(12, 5) = Res
  Set oSList = Nothing: Set oSList2 = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Em có check thử, thành viên mới nên gặp khó khăn trong việc xử lí lỗi và hiểu code
1. Em gặp vấn đề frame 2.0 => em đã xử líđọc lại bài xử líđược rồi
2. Giờ em đang bị lỗi (80004003) key cannot be null
tại dòng lệnh: oSList.Item(sArr(i, 2)) = oSList.Item(sArr(i, 2)) + sArr(i, 4)
Em chưa xử lí được => mong bác giúp đỡ
 
Upvote 0
cauthi_toiuu đã viết:
Em có check thử, thành viên mới nên gặp khó khăn trong việc xử lí lỗi và hiểu code
1. Em gặp vấn đề frame 2.0 => em đã xử líđọc lại bài xử líđược rồi
2. Giờ em đang bị lỗi (80004003) key cannot be null
tại dòng lệnh: oSList.Item(sArr(i, 2)) = oSList.Item(sArr(i, 2)) + sArr(i, 4)
Em chưa xử lí được => mong bác giúp đỡ
Nhấp chuột vào đây để mở rộng...
Thêm lệnh loại dòng trống
Mã: 
Sub Worst_Report()
  Dim sArr(), Res(), oSList As Object, oSList2 As Object, S, S2, iItem$
  Dim iDate As Date, sRow&, i&, kCH&, tmp, iK&, k&, r&
 
  iDate = Sheets("Report").Range("C2").Value
  Set oSList = CreateObject("System.Collections.SortedList")
  Set oSList2 = CreateObject("System.Collections.SortedList")
  With Sheets("Data")
    sArr = .Range("B5", .Range("E" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  For i = 1 To sRow
    If sArr(i, 1) = iDate Then
      If sArr(i, 2) <> Empty Then
        oSList.Item(sArr(i, 2)) = oSList.Item(sArr(i, 2)) + sArr(i, 4)
        oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) = oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) + sArr(i, 4)
      End If
    End If
  Next i
  sRow = oSList.Count - 1
  For i = 0 To sRow
    oSList2.Item(oSList.GetByIndex(i)) = oSList2.Item(oSList.GetByIndex(i)) & "," & oSList.GetKey(i)
  Next i
  ReDim Res(1 To 12, 1 To 5)
  sRow = oSList2.Count - 1
  For i = sRow To 0 Step -1
    S = Split(oSList2.GetByIndex(i), ",")
    For r = 1 To UBound(S)
      iItem = S(r)
      If InStr(1, iItem, "#") = 0 Then
        If kCH < 4 Then
          kCH = kCH + 1
          iK = kCH * 3 - 2
          Res(iK, 1) = kCH:          Res(iK, 2) = iItem
          oSList.Item(iItem) = iK
        End If
      Else
        S2 = Split(S(r), "#")
        tmp = S2(0):        iK = oSList.Item(tmp)
        If iK > 0 And iK < 13 Then
          Res(iK, 3) = S2(1)
          tmp = S(r):       Res(iK, 4) = oSList.Item(tmp)
          k = ((iK - 1) \ 3) * 3 + 1
          Res(k, 5) = Res(k, 5) + Res(iK, 4)
          If (iK Mod 3) = 0 Then
            tmp = S2(0): oSList.Item(tmp) = 0
          Else
            tmp = S2(0): oSList.Item(tmp) = iK + 1
          End If
        End If
      End If
    Next r
  Next i
  Sheets("Report").Range("A5").Resize(12, 5) = Res
  Set oSList = Nothing: Set oSList2 = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
HieuCD đã viết:
Thêm lệnh loại dòng trống
Mã: 
Sub Worst_Report()
  Dim sArr(), Res(), oSList As Object, oSList2 As Object, S, S2, iItem$
  Dim iDate As Date, sRow&, i&, kCH&, tmp, iK&, k&, r&

  iDate = Sheets("Report").Range("C2").Value
  Set oSList = CreateObject("System.Collections.SortedList")
  Set oSList2 = CreateObject("System.Collections.SortedList")
  With Sheets("Data")
    sArr = .Range("B2", .Range("E" & Rows.Count)).Value
  End With
  sRow = UBound(sArr)
  For i = 1 To sRow
    If sArr(i, 1) = iDate Then
      If sArr(i, 2) <> Empty Then
        oSList.Item(sArr(i, 2)) = oSList.Item(sArr(i, 2)) + sArr(i, 4)
        oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) = oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) + sArr(i, 4)
      End If
    End If
  Next i
  sRow = oSList.Count - 1
  For i = 0 To sRow
    oSList2.Item(oSList.GetByIndex(i)) = oSList2.Item(oSList.GetByIndex(i)) & "," & oSList.GetKey(i)
  Next i
  ReDim Res(1 To 12, 1 To 5)
  sRow = oSList2.Count - 1
  For i = sRow To 0 Step -1
    S = Split(oSList2.GetByIndex(i), ",")
    For r = 1 To UBound(S)
      iItem = S(r)
      If InStr(1, iItem, "#") = 0 Then
        If kCH < 4 Then
          kCH = kCH + 1
          iK = kCH * 3 - 2
          Res(iK, 1) = kCH:          Res(iK, 2) = iItem
          oSList.Item(iItem) = iK
        End If
      Else
        S2 = Split(S(r), "#")
        tmp = S2(0):        iK = oSList.Item(tmp)
        If iK > 0 Then
          Res(iK, 3) = S2(1)
          tmp = S(r):       Res(iK, 4) = oSList.Item(tmp)
          k = ((iK - 1) \ 3) * 3 + 1
          Res(k, 5) = Res(k, 5) + Res(iK, 4)
          If (iK Mod 3) = 0 Then
            tmp = S2(0): oSList.Item(tmp) = 0
          Else
            tmp = S2(0): oSList.Item(tmp) = iK + 1
          End If
        End If
      End If
    Next r
  Next i
  Sheets("Report").Range("A5").Resize(12, 5) = Res
  Set oSList = Nothing: Set oSList2 = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Anh Hiếu hình như là không đúng lắm em thấy file bắt đầu từ dòng 5 mà.
Cái này hình như là nó chạy đến cuối bảng tính.

Mã: 
  With Sheets("Data")
    sArr = .Range("B2", .Range("E" & Rows.Count)).Value
  End With
 
Upvote 0
snow25 đã viết:
Anh Hiếu hình như là không đúng lắm em thấy file bắt đầu từ dòng 5 mà.
Cái này hình như là nó chạy đến cuối bảng tính.

Mã: 
  With Sheets("Data")
    sArr = .Range("B2", .Range("E" & Rows.Count)).Value
  End With
Nhấp chuột vào đây để mở rộng...
Không hiểu sao bị sai cơ bản nữa o_O :(
Chỉnh lại
Mã: 
Sub Worst_Report()
  Dim sArr(), Res(), oSList As Object, oSList2 As Object, S, S2, iItem$
  Dim iDate As Date, sRow&, i&, kCH&, tmp, iK&, k&, r&
 
  iDate = Sheets("Report").Range("C2").Value
  Set oSList = CreateObject("System.Collections.SortedList")
  Set oSList2 = CreateObject("System.Collections.SortedList")
  With Sheets("Data")
    sArr = .Range("B5", .Range("E" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  For i = 1 To sRow
    If sArr(i, 1) = iDate Then
      If sArr(i, 2) <> Empty Then
        oSList.Item(sArr(i, 2)) = oSList.Item(sArr(i, 2)) + sArr(i, 4)
        oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) = oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) + sArr(i, 4)
      End If
    End If
  Next i
  sRow = oSList.Count - 1
  For i = 0 To sRow
    oSList2.Item(oSList.GetByIndex(i)) = oSList2.Item(oSList.GetByIndex(i)) & "," & oSList.GetKey(i)
  Next i
  ReDim Res(1 To 12, 1 To 5)
  sRow = oSList2.Count - 1
  For i = sRow To 0 Step -1
    S = Split(oSList2.GetByIndex(i), ",")
    For r = 1 To UBound(S)
      iItem = S(r)
      If InStr(1, iItem, "#") = 0 Then
        If kCH < 4 Then
          kCH = kCH + 1
          iK = kCH * 3 - 2
          Res(iK, 1) = kCH:          Res(iK, 2) = iItem
          oSList.Item(iItem) = iK
        End If
      Else
        S2 = Split(S(r), "#")
        tmp = S2(0):        iK = oSList.Item(tmp)
        If iK > 0 And iK < 13 Then
          Res(iK, 3) = S2(1)
          tmp = S(r):       Res(iK, 4) = oSList.Item(tmp)
          k = ((iK - 1) \ 3) * 3 + 1
          Res(k, 5) = Res(k, 5) + Res(iK, 4)
          If (iK Mod 3) = 0 Then
            tmp = S2(0): oSList.Item(tmp) = 0
          Else
            tmp = S2(0): oSList.Item(tmp) = iK + 1
          End If
        End If
      End If
    Next r
  Next i
  Sheets("Report").Range("A5").Resize(12, 5) = Res
  Set oSList = Nothing: Set oSList2 = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
iDate = Sheets("Report").Range("C2").Value
Cảm ơn anh Hiếu.
Đoạn code này gán biến iDate = ngày cần lập worst có phải không anh (sheet của em là B1)
Em có thử chạy rồi, vi diệu quá. VBA thật tuyệt vời
Chắc phải ngồi ngẫm và search để hiểu từng dòng code quá. Giá như có ghi chú ' cho từngđoạn thì em có thể tùy biến trong các bài tương tự
Anh có đường dẫn nào về tổng hợp kiến thức mảng từ sơ đảng đến nâng cao => cho em xin với nhé
Cảm ơn anh!
 
Lần chỉnh sửa cuối:
Upvote 0
cauthi_toiuu đã viết:
iDate = Sheets("Report").Range("C2").Value
Cảm ơn anh Hiếu.
Đoạn code này gán biến iDate = ngày cần lập worst có phải không anh (sheet của em là B1)
Em có thử chạy rồi, vi diệu quá. VBA thật tuyệt vời
Chắc phải ngồi ngẫm và search để hiểu từng dòng code quá. Giá như có ghi chú ' cho từngđoạn thì em có thể tùy biến trong các bài tương tự
Anh có đường dẫn nào về tổng hợp kiến thức mảng từ sơ đảng đến nâng cao => cho em xin với nhé
Cảm ơn anh!
Nhấp chuột vào đây để mở rộng...
Bài nầy thuật toán rất phức tạp, rất khó ghi chú để bạn hiểu lý do các lệnh
Mã: 
Sub Worst_Report()
  Dim sArr(), Res(), oSList As Object, oSList2 As Object, S, S2, iItem$
  Dim iDate As Date, sRow&, i&, kCH&, tmp, iK&, k&, r&
 
  iDate = Sheets("Report").Range("C2").Value 'Ngay Bao cao
  Set oSList = CreateObject("System.Collections.SortedList") 'Tính Tong So luong theo CuaHang và CuaHang_MatHang
  Set oSList2 = CreateObject("System.Collections.SortedList") 'Sort theo Tong So luong
  With Sheets("Data")
    sArr = .Range("B5", .Range("E" & Rows.Count).End(xlUp)).Value 'Du lieu nguon
  End With
  sRow = UBound(sArr) 'So dong du lieu nguon
  For i = 1 To sRow
    If sArr(i, 1) = iDate Then
      If sArr(i, 2) <> Empty Then
        oSList.Item(sArr(i, 2)) = oSList.Item(sArr(i, 2)) + sArr(i, 4) 'Tính Tong So luong theo CuaHang
        oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) = oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) + sArr(i, 4) 'Tính Tong So luong theo CuaHang_MatHang
      End If
    End If
  Next i
  sRow = oSList.Count - 1 'Thu tu dong cuoi cua oSList
  For i = 0 To sRow
    'Sort tu thap toi cao theo Tong So luong
    'gan Key là Tong So luong voi iTem là CuaHang hoac CuaHang_MatHang
    'Tong So luong CuaHang >= Tong So luong CuaHang_MatHang
    oSList2.Item(oSList.GetByIndex(i)) = oSList2.Item(oSList.GetByIndex(i)) & "," & oSList.GetKey(i)
  Next i
  ReDim Res(1 To 12, 1 To 5) 'Mang ket qua
  sRow = oSList2.Count - 1 'Thu tu dong cuoi cua oSList2
  For i = sRow To 0 Step -1
    S = Split(oSList2.GetByIndex(i), ",") 'Mang cac gia tri la CuaHang hoac CuaHang_MatHang
    For r = 1 To UBound(S)
      iItem = S(r)
      If InStr(1, iItem, "#") = 0 Then 'Mang cac gia tri la CuaHang
        If kCH < 4 Then 'Gioi han chi lay 4 CuaHang
          kCH = kCH + 1
          iK = kCH * 3 - 2 'Thu tu dong Cua hang cua mang ket qua (1, 4, 7, 10)
          Res(iK, 1) = kCH 'So thu tu Cua hang
          Res(iK, 2) = iItem 'Ten Cua hang
          oSList.Item(iItem) = iK 'Thu tu dong mat hang cua CuaHang co Tong So luong lon nhat
        End If
      Else 'Mang cac gia tri la CuaHang_MatHang
        S2 = Split(S(r), "#")
        tmp = S2(0):        iK = oSList.Item(tmp) 'Thu tu dong mat hang mang ket qua
        If iK > 0 And iK < 13 Then 'Mang ket qua co thu tu dong: tu 1 toi 12
          Res(iK, 3) = S2(1) 'Ten Mat hang
          tmp = S(r):       Res(iK, 4) = oSList.Item(tmp) 'Tong So luong MatHang
          k = ((iK - 1) \ 3) * 3 + 1 'Thu tu dong Cua hang
          Res(k, 5) = Res(k, 5) + Res(iK, 4) 'Tong So luong CuaHang
          If (iK Mod 3) = 0 Then
            tmp = S2(0): oSList.Item(tmp) = 0 'Da lay du 3 MatHang, khong lay them
          Else
            tmp = S2(0): oSList.Item(tmp) = iK + 1 'Thu tu dong mat hang ke tiep
          End If
        End If
      End If
    Next r
  Next i
  Sheets("Report").Range("A5").Resize(12, 5) = Res 'Gan ket qua
  Set oSList = Nothing: Set oSList2 = Nothing
End Sub
 
Upvote 0
babyheomoi đã viết:
Chưa hiểu mục đích thống kê bài này của bạn!
Nhấp chuột vào đây để mở rộng...
Bài này em tự bịa bác ạ!
=> mục đính lập worst các đối tượng thôi bác
Bài đã được tự động gộp:

HieuCD đã viết:
Bài nầy thuật toán rất phức tạp, rất khó ghi chú để bạn hiểu lý do các lệnh
Mã: 
Sub Worst_Report()
  Dim sArr(), Res(), oSList As Object, oSList2 As Object, S, S2, iItem$
  Dim iDate As Date, sRow&, i&, kCH&, tmp, iK&, k&, r&

  iDate = Sheets("Report").Range("C2").Value 'Ngay Bao cao
  Set oSList = CreateObject("System.Collections.SortedList") 'Tính Tong So luong theo CuaHang và CuaHang_MatHang
  Set oSList2 = CreateObject("System.Collections.SortedList") 'Sort theo Tong So luong
  With Sheets("Data")
    sArr = .Range("B5", .Range("E" & Rows.Count).End(xlUp)).Value 'Du lieu nguon
  End With
  sRow = UBound(sArr) 'So dong du lieu nguon
  For i = 1 To sRow
    If sArr(i, 1) = iDate Then
      If sArr(i, 2) <> Empty Then
        oSList.Item(sArr(i, 2)) = oSList.Item(sArr(i, 2)) + sArr(i, 4) 'Tính Tong So luong theo CuaHang
        oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) = oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) + sArr(i, 4) 'Tính Tong So luong theo CuaHang_MatHang
      End If
    End If
  Next i
  sRow = oSList.Count - 1 'Thu tu dong cuoi cua oSList
  For i = 0 To sRow
    'Sort tu thap toi cao theo Tong So luong
    'gan Key là Tong So luong voi iTem là CuaHang hoac CuaHang_MatHang
    'Tong So luong CuaHang >= Tong So luong CuaHang_MatHang
    oSList2.Item(oSList.GetByIndex(i)) = oSList2.Item(oSList.GetByIndex(i)) & "," & oSList.GetKey(i)
  Next i
  ReDim Res(1 To 12, 1 To 5) 'Mang ket qua
  sRow = oSList2.Count - 1 'Thu tu dong cuoi cua oSList2
  For i = sRow To 0 Step -1
    S = Split(oSList2.GetByIndex(i), ",") 'Mang cac gia tri la CuaHang hoac CuaHang_MatHang
    For r = 1 To UBound(S)
      iItem = S(r)
      If InStr(1, iItem, "#") = 0 Then 'Mang cac gia tri la CuaHang
        If kCH < 4 Then 'Gioi han chi lay 4 CuaHang
          kCH = kCH + 1
          iK = kCH * 3 - 2 'Thu tu dong Cua hang cua mang ket qua (1, 4, 7, 10)
          Res(iK, 1) = kCH 'So thu tu Cua hang
          Res(iK, 2) = iItem 'Ten Cua hang
          oSList.Item(iItem) = iK 'Thu tu dong mat hang cua CuaHang co Tong So luong lon nhat
        End If
      Else 'Mang cac gia tri la CuaHang_MatHang
        S2 = Split(S(r), "#")
        tmp = S2(0):        iK = oSList.Item(tmp) 'Thu tu dong mat hang mang ket qua
        If iK > 0 And iK < 13 Then 'Mang ket qua co thu tu dong: tu 1 toi 12
          Res(iK, 3) = S2(1) 'Ten Mat hang
          tmp = S(r):       Res(iK, 4) = oSList.Item(tmp) 'Tong So luong MatHang
          k = ((iK - 1) \ 3) * 3 + 1 'Thu tu dong Cua hang
          Res(k, 5) = Res(k, 5) + Res(iK, 4) 'Tong So luong CuaHang
          If (iK Mod 3) = 0 Then
            tmp = S2(0): oSList.Item(tmp) = 0 'Da lay du 3 MatHang, khong lay them
          Else
            tmp = S2(0): oSList.Item(tmp) = iK + 1 'Thu tu dong mat hang ke tiep
          End If
        End If
      End If
    Next r
  Next i
  Sheets("Report").Range("A5").Resize(12, 5) = Res 'Gan ket qua
  Set oSList = Nothing: Set oSList2 = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác!!!
Em ngẫm thêm.
 
Upvote 0
HieuCD đã viết:
Bài nầy thuật toán rất phức tạp, rất khó ghi chú để bạn hiểu lý do các lệnh
Mã: 
Sub Worst_Report()
  Dim sArr(), Res(), oSList As Object, oSList2 As Object, S, S2, iItem$
  Dim iDate As Date, sRow&, i&, kCH&, tmp, iK&, k&, r&

  iDate = Sheets("Report").Range("C2").Value 'Ngay Bao cao
  Set oSList = CreateObject("System.Collections.SortedList") 'Tính Tong So luong theo CuaHang và CuaHang_MatHang
  Set oSList2 = CreateObject("System.Collections.SortedList") 'Sort theo Tong So luong
  With Sheets("Data")
    sArr = .Range("B5", .Range("E" & Rows.Count).End(xlUp)).Value 'Du lieu nguon
  End With
  sRow = UBound(sArr) 'So dong du lieu nguon
  For i = 1 To sRow
    If sArr(i, 1) = iDate Then
      If sArr(i, 2) <> Empty Then
        oSList.Item(sArr(i, 2)) = oSList.Item(sArr(i, 2)) + sArr(i, 4) 'Tính Tong So luong theo CuaHang
        oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) = oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) + sArr(i, 4) 'Tính Tong So luong theo CuaHang_MatHang
      End If
    End If
  Next i
  sRow = oSList.Count - 1 'Thu tu dong cuoi cua oSList
  For i = 0 To sRow
    'Sort tu thap toi cao theo Tong So luong
    'gan Key là Tong So luong voi iTem là CuaHang hoac CuaHang_MatHang
    'Tong So luong CuaHang >= Tong So luong CuaHang_MatHang
    oSList2.Item(oSList.GetByIndex(i)) = oSList2.Item(oSList.GetByIndex(i)) & "," & oSList.GetKey(i)
  Next i
  ReDim Res(1 To 12, 1 To 5) 'Mang ket qua
  sRow = oSList2.Count - 1 'Thu tu dong cuoi cua oSList2
  For i = sRow To 0 Step -1
    S = Split(oSList2.GetByIndex(i), ",") 'Mang cac gia tri la CuaHang hoac CuaHang_MatHang
    For r = 1 To UBound(S)
      iItem = S(r)
      If InStr(1, iItem, "#") = 0 Then 'Mang cac gia tri la CuaHang
        If kCH < 4 Then 'Gioi han chi lay 4 CuaHang
          kCH = kCH + 1
          iK = kCH * 3 - 2 'Thu tu dong Cua hang cua mang ket qua (1, 4, 7, 10)
          Res(iK, 1) = kCH 'So thu tu Cua hang
          Res(iK, 2) = iItem 'Ten Cua hang
          oSList.Item(iItem) = iK 'Thu tu dong mat hang cua CuaHang co Tong So luong lon nhat
        End If
      Else 'Mang cac gia tri la CuaHang_MatHang
        S2 = Split(S(r), "#")
        tmp = S2(0):        iK = oSList.Item(tmp) 'Thu tu dong mat hang mang ket qua
        If iK > 0 And iK < 13 Then 'Mang ket qua co thu tu dong: tu 1 toi 12
          Res(iK, 3) = S2(1) 'Ten Mat hang
          tmp = S(r):       Res(iK, 4) = oSList.Item(tmp) 'Tong So luong MatHang
          k = ((iK - 1) \ 3) * 3 + 1 'Thu tu dong Cua hang
          Res(k, 5) = Res(k, 5) + Res(iK, 4) 'Tong So luong CuaHang
          If (iK Mod 3) = 0 Then
            tmp = S2(0): oSList.Item(tmp) = 0 'Da lay du 3 MatHang, khong lay them
          Else
            tmp = S2(0): oSList.Item(tmp) = iK + 1 'Thu tu dong mat hang ke tiep
          End If
        End If
      End If
    Next r
  Next i
  Sheets("Report").Range("A5").Resize(12, 5) = Res 'Gan ket qua
  Set oSList = Nothing: Set oSList2 = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Đọc code và không hiểu gì anh Hiếu à.
 
Upvote 0
Upvote 0
VetMini đã viết:
Không xứng đáng vận não.
Lúc đầu tôi cũng mất 15 phút để suy nghĩ "worst" có nghĩa là gì. Sau đó chịu thua.
Bây giờ mới biết tại sao.
Nhấp chuột vào đây để mở rộng...
Sao bác lại bảo không xứng đáng vận não vậy?
Bài toàn xuất phát từ như cầu thực tế. Cần kiểm tra xem mỗi ngày, cửa hàng nào bán được nhiều nhất, và trong cửa hàng thì mặt hàng nào bán được nhiều nhất => đánh giá
Còn file excel em hỏi bài là 1 bài dữ liệu em bịa tương tự, bài toán có thể làm bằng excel, và pivot nhưng cần qua nhiều bước trung gian và thao tác.
Em muốn học hỏi VBA tự động hóa và nhẹ, bác lại nói thế hóa ra em bịa viển vông để làm phiền các bác sao?
 
Upvote 0
VetMini đã viết:
Không xứng đáng vận não.
Lúc đầu tôi cũng mất 15 phút để suy nghĩ "worst" có nghĩa là gì. Sau đó chịu thua.
Nhấp chuột vào đây để mở rộng...
Trước hết tôi tra từ điển của tôi. Dốt ngoại ngữ mà. Nhưng sau khi đọc

worst.JPG

thì tôi hiểu là mình không thể hiểu tác giả muốn gì. Và tôi nghỉ luôn, chả tò mò nữa. Mình có hiểu worst nó là cái quái gì đâu mà đòi tò mò.
 
Upvote 0
batman1 đã viết:
Trước hết tôi tra từ điển của tôi. Dốt ngoại ngữ mà. Nhưng sau khi đọc

View attachment 236827

thì tôi hiểu là mình không thể hiểu tác giả muốn gì. Và tôi nghỉ luôn, chả tò mò nữa. Mình có hiểu worst nó là cái quái gì đâu mà đòi tò mò.
Nhấp chuột vào đây để mở rộng...
À. Mấu chốt là nhu cầu của em là xuất phát từ việc thống kê lỗi, cái xấu nên dùng từ worst là để chỉ những thứ tệ nhất, tệ nhì, tệ 3...
Còn bài em bịa thì liên quan đến việc bán hàng nên nó k phải là tệ nhất, dùng từ k chuẩn, có file excel em kèm em có mô tả. Em thấy bài này vba rất hay. Cần phải học rất nhiều. Đang ngẫm xem đoạn nào cần hỏi a Hiếu
 
Upvote 0
cauthi_toiuu đã viết:
À. Mấu chốt là nhu cầu của em là xuất phát từ việc thống kê lỗi, cái xấu nên dùng từ worst là để chỉ những thứ tệ nhất, tệ nhì, tệ 3...
Còn bài em bịa thì liên quan đến việc bán hàng nên nó k phải là tệ nhất, dùng từ k chuẩn, có file excel em kèm em có mô tả. Em thấy bài này vba rất hay. Cần phải học rất nhiều. Đang ngẫm xem đoạn nào cần hỏi a Hiếu
Nhấp chuột vào đây để mở rộng...
Thì tôi đọc mô tả mà.
Do bạn viết
Chi tiết mình mô tả kĩ trong file đính kèm
Nhấp chuột vào đây để mở rộng...
nên tôi bỏ công ra tải tập tin về. Trong mô tả có 1 wost (chắc gõ thiếu), và 7 worst.

Giải thích cho người Việt thì dùng tiếng Việt thôi. Vd. giải thích như bài #13. Có thể không dùng worst được không? Rõ ràng là có thể. Bài #13 là minh chứng.
 
Upvote 0
batman1 đã viết:
Thì tôi đọc mô tả mà.
Do bạn viết

nên tôi bỏ công ra tải tập tin về. Trong mô tả có 1 wost (chắc gõ thiếu), và 7 worst.
Giải thích cho người Việt thì dùng tiếng Việt thôi. Vd. giải thích như bài #13. Có thể không dùng worst được không? Rõ ràng là có thể. Bài #13 là minh chứng.
Nhấp chuột vào đây để mở rộng...
=> Đây là phần mô tả trong file của em. Cũng có nói về cái mà e gọi là worst.
Bác share giúp em ít nghĩa tường minh của code a Hiếu với. Khó hiểu quá
Nội dung như sau
1. Có sheet data như sheet bên, số lượng bán hàng của từng cửa hàng, từng mặt hàng theo cửa hàng và số lượng bán tương ứng
2. Sheet data này update thay đổi liên tục (Thêm mặt hàng, thêm dữ liệu vào các ngày…)
Yêu cầu: Dùng VBA (pivot mình k làm theo được format sẵn như bảng bên)
1. Lập báo theo worst cửa hàng theo thứ tự 1, 2, 3, 4(4 worst), (worst là đối tượng lặp lại nhiều nhất, thứ nhì, thứ 3, thứ 4), trong mỗi cửa hàng thì lấy 3 worst mặt hàng và số lượng tương ứng mặt hàng của cửa hàng đó (như bảng bên Worst report) theo từng ngày (giả sử bên là 1-May khi thay ngày khác thì bảng có thể tự update)
Chú ý
- Nếu chỉ có ngày 1-May mà chỉ có 2 cửa hàng hoặc chỉ có 2 mặt hàng wost k có đến dữ liệu worst 3 thì worst 3 để trống hoặc "-"
- Nếu có nhiều hơn 2 cửa hàng hoặc mặt hàng mà có số lượng bán hàng bằng nhau thì chỉ lấy 1 (cái nào cũng được) để điền đúng format như report bên
 
Upvote 0
cauthi_toiuu đã viết:
=> Đây là phần mô tả trong file của em. Cũng có nói về cái mà e gọi là worst.
Bác share giúp em ít nghĩa tường minh của code a Hiếu với. Khó hiểu quá
Nội dung như sau
1. Có sheet data như sheet bên, số lượng bán hàng của từng cửa hàng, từng mặt hàng theo cửa hàng và số lượng bán tương ứng
2. Sheet data này update thay đổi liên tục (Thêm mặt hàng, thêm dữ liệu vào các ngày…)
Yêu cầu: Dùng VBA (pivot mình k làm theo được format sẵn như bảng bên)
1. Lập báo theo worst cửa hàng theo thứ tự 1, 2, 3, 4(4 worst), (worst là đối tượng lặp lại nhiều nhất, thứ nhì, thứ 3, thứ 4), trong mỗi cửa hàng thì lấy 3 worst mặt hàng và số lượng tương ứng mặt hàng của cửa hàng đó (như bảng bên Worst report) theo từng ngày (giả sử bên là 1-May khi thay ngày khác thì bảng có thể tự update)
Chú ý
- Nếu chỉ có ngày 1-May mà chỉ có 2 cửa hàng hoặc chỉ có 2 mặt hàng wost k có đến dữ liệu worst 3 thì worst 3 để trống hoặc "-"
- Nếu có nhiều hơn 2 cửa hàng hoặc mặt hàng mà có số lượng bán hàng bằng nhau thì chỉ lấy 1 (cái nào cũng được) để điền đúng format như report bên
Nhấp chuột vào đây để mở rộng...
Tôi nói không xứng đáng vận não bởi vì bạn nói chuyện hết sức lủng củng. Cứ nhìn trên, có bao giờ số tiểu mục lại đi từ "1." sang "2." rồi trở về "1." không? Chỉ xảy ra trong lối nói chuyện của bạn.

Từ "worst":
từ này thể là tĩnh từ, trạng từ, danh từ, hay động từ, tuỳ theo câu.
Cách bạn dùng từ chả xác định nó là cái nào. Chỉ biết chắc nó không phải động từ thôi.
Điển hình: 4 worst (tô tím ở trên) có nghĩa là 4 cái tệ nhất?
nếu đi với cụm từ "thứ tự", thì đáng lẽ nó phải là 1st, 2nd, 3rd, và 4th-worst chứ.
 
Upvote 0
VetMini đã viết:
Tôi nói không xứng đáng vận não bởi vì bạn nói chuyện hết sức lủng củng. Cứ nhìn trên, có bao giờ số tiểu mục lại đi từ "1." sang "2." rồi trở về "1." không? Chỉ xảy ra trong lối nói chuyện của bạn.

Từ "worst":
từ này thể là tĩnh từ, trạng từ, danh từ, hay động từ, tuỳ theo câu.
Cách bạn dùng từ chả xác định nó là cái nào. Chỉ biết chắc nó không phải động từ thôi.
Điển hình: 4 worst (tô tím ở trên) có nghĩa là 4 cái tệ nhất?
nếu đi với cụm từ "thứ tự", thì đáng lẽ nó phải là 1st, 2nd, 3rd, và 4th-worst chứ.
Nhấp chuột vào đây để mở rộng...
Vâng, em rút kinh nghiệm
Cảm ơn các bác góp ý
 
Upvote 0
HieuCD đã viết:
Không hiểu sao bị sai cơ bản nữa o_O :(
Chỉnh lại
Mã: 
Sub Worst_Report()
  Dim sArr(), Res(), oSList As Object, oSList2 As Object, S, S2, iItem$
  Dim iDate As Date, sRow&, i&, kCH&, tmp, iK&, k&, r&

  iDate = Sheets("Report").Range("C2").Value
  Set oSList = CreateObject("System.Collections.SortedList")
  Set oSList2 = CreateObject("System.Collections.SortedList")
  With Sheets("Data")
    sArr = .Range("B5", .Range("E" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  For i = 1 To sRow
    If sArr(i, 1) = iDate Then
      If sArr(i, 2) <> Empty Then
        oSList.Item(sArr(i, 2)) = oSList.Item(sArr(i, 2)) + sArr(i, 4)
        oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) = oSList.Item(sArr(i, 2) & "#" & sArr(i, 3)) + sArr(i, 4)
      End If
    End If
  Next i
  sRow = oSList.Count - 1
  For i = 0 To sRow
    oSList2.Item(oSList.GetByIndex(i)) = oSList2.Item(oSList.GetByIndex(i)) & "," & oSList.GetKey(i)
  Next i
  ReDim Res(1 To 12, 1 To 5)
  sRow = oSList2.Count - 1
  For i = sRow To 0 Step -1
    S = Split(oSList2.GetByIndex(i), ",")
    For r = 1 To UBound(S)
      iItem = S(r)
      If InStr(1, iItem, "#") = 0 Then
        If kCH < 4 Then
          kCH = kCH + 1
          iK = kCH * 3 - 2
          Res(iK, 1) = kCH:          Res(iK, 2) = iItem
          oSList.Item(iItem) = iK
        End If
      Else
        S2 = Split(S(r), "#")
        tmp = S2(0):        iK = oSList.Item(tmp)
        If iK > 0 And iK < 13 Then
          Res(iK, 3) = S2(1)
          tmp = S(r):       Res(iK, 4) = oSList.Item(tmp)
          k = ((iK - 1) \ 3) * 3 + 1
          Res(k, 5) = Res(k, 5) + Res(iK, 4)
          If (iK Mod 3) = 0 Then
            tmp = S2(0): oSList.Item(tmp) = 0
          Else
            tmp = S2(0): oSList.Item(tmp) = iK + 1
          End If
        End If
      End If
    Next r
  Next i
  Sheets("Report").Range("A5").Resize(12, 5) = Res
  Set oSList = Nothing: Set oSList2 = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Anh Hiếu ơi, giúp em lại bài này
Sau~1 tuần e test và tìm hiểu, nhưng không ra vấn đề
1. Dữ liệu em hỏi ở #1, em test code của anh thì đúng. Nhưng khi em mở rộng dữ liệu ra thì kết quả không đúng. Data test mà cho kết quả không đúng em đính kèm ở bài này
2. Giả sử cột cửa hàng có tên là Cửa hàng A,C thay vì chỉ là cửa hàng A hoặc cửa hàng C (nghĩa là có dấu , trong tên cửa hàng) vậy nên sửa code này phải không anh? S = Split(oSList2.GetByIndex(i), ",")
 

File đính kèm

  • Hỏi bài - Test loi.xlsm
    82.4 KB · Đọc: 3
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

H
Sửa code tính lũy kế ạ
Trả lời
3
Đọc
15
Hoàng Tuấn 868
H
Quyen182
  • Question
Nhờ chỉnh code VBA để tô màu dòng chứa Activecell và không làm mất màu gốc
Trả lời
3
Đọc
73
HeSanbi
HeSanbi
H
Nhờ hướng dẫn tạo bảng như hình vẽ
Trả lời
0
Đọc
22
hoaiantrinh
H
L
Đổi màu chữ trong VBA
Trả lời
11
Đọc
100
lvh1064
L
V
Chỉ cách sửa lỗi trong Excell
Trả lời
1
Đọc
29
A-T
A
T
Không đếm dữ liệu rỗng trong PivotTable
Trả lời
9
Đọc
1K
Dũng NĐ
Dũng NĐ
H
Hỗ trợ lấy danh sách dữ liệu thỏa mãn điều kiện
Trả lời
3
Đọc
137
DeTong
D
PhanTuHuong
Bàn về môn thể thao bóng bàn nào!
    • Thích
    • Yêu thích
    • Cười
2
Trả lời
38
Đọc
2K
lvh1064
L
salam
Ẩn ảnh sau chữ trong excel
Trả lời
11
Đọc
29K
itusbbk
itusbbk
nobita994
Trừ số lượng dần theo dòng khi quét Sumif tổng có tên sản phẩm bị trùng.
Trả lời
4
Đọc
125
nobita994
nobita994
F
  • Question
Nhờ tư vấn cách tạo QR trong Excel
Trả lời
7
Đọc
552
huuthang_bd
huuthang_bd
nguyen trung cuong
File chứa marco không mở được.
Trả lời
3
Đọc
108
hvnhpro
H
Tienvinh191
  • Question
Nhờ viết Code lấy dữ liệu tờ khai hải quan vào bảng tổng hợp
2
Trả lời
25
Đọc
2K
haott
H
CodyPham97
tạo biểu tượng thay thế nhấn đúp chuột
Trả lời
4
Đọc
94
phansythao
phansythao
dovanha1994
Giúp e tìm nguyên nhân sai và hướng dẫn e đọc file này với ạ
    • Phẫn nộ
Trả lời
4
Đọc
134
SA_DQ
SA_DQ
20050911
File Excel lỗi ''The file could not be accessed. Try one of the following:.."
Trả lời
10
Đọc
605
20050911
20050911
N
Giúp sửa mã code
2
Trả lời
20
Đọc
470
Nguyễn Diêu Hiền
N
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11/2024
    • Thích
    • Yêu thích
Trả lời
1
Đọc
101
SA_DQ
SA_DQ
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
32
Đọc
891
VetMini
V
K
Nhờ mọi người hoàn thiện giúp công thức
Trả lời
4
Đọc
124
kiendt1973
K
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

Back
Top Bottom