Cách nhập dữ liệu tự động chia theo danh mục chiết khấu từng sản phẩm

[LearningExcel]

Em xin chào mọi người, em là thành viên mới tham gia vào nhóm. Vì cũng không chuyên về excel nên em cũng mạo muội nhờ các anh đi trước, có nhiều kinh nghiệm để hướng dẫn giúp em cách tính bài toán này ạ. Hiện tại em được giao làm một việc, tách ra thông tin những người bán hàng hóa trong vòng một tháng qua. Dạ em có đính kèm những hình dưới đây là mẫu báo cáo em đã xuất ra từ hệ thống. Giờ cách làm là làm thế nào để chia ra nhân viên đó đã bán được bao nhiêu sản phẩm và sản phẩm đó thuộc chiết khấu bao nhiêu. Chiết khấu thì có thể quy định bao gồm: 15%, 20%, 24%, 24.5%.. mỗi chiết khấu sẽ được đại diện cho danh mục thuộc tính của sản phẩm đó(em có đính kèm ảnh). Ví dụ được 2 sản phẩm thì có thể gộp cùng chiết khấu của một sản phẩm đó dựa theo tên của nhân viên đó. Tương tự với những nhân viên khác cũng vậy.. Có 2 loại hàng tiêu dùng là: Hàng BTCom và Hàng cty PHBC. Mỗi loại mặt hàng sẽ chia ra khác nhau để tránh tính nhầm lẫn. Dựa theo file gốc xuất ra từ hệ thống để có thể biết được nhân viên đó bán được bao nhiêu sản phẩm, theo từng loại chiết khấu nào. Em thật sự không biết cách tách và gọi hàm trong VBA thể nào, vì đây cũng là công việc gấp mà e cũng không có nhiều thời gian để nghiên cứu.. Em thì làm bên android, nhưng em nghĩ không thể thực hiện được vì nó khá rườm rà, và rắc rối cho người thực hiện sau này. Nên em nghĩ làm trên excel là cách nhanh và hiệu quả nhất, để chỉ cần click chọn theo danh mục sản phẩm thì sẽ tự động tính luôn ạ. Vì sau này nếu làm xong thì em sẽ phải hướng dẫn lại cho dưới đơn vị cho họ làm ạ. Em nhờ các anh đi trước giúp đỡ ạ. Em cảm ơn nhiều ạ !

 

[HieuCD]

Em xin chào mọi người, em là thành viên mới tham gia vào nhóm. Vì cũng không chuyên về excel nên em cũng mạo muội nhờ các anh đi trước, có nhiều kinh nghiệm để hướng dẫn giúp em cách tính bài toán này ạ. Hiện tại em được giao làm một việc, tách ra thông tin những người bán hàng hóa trong vòng một tháng qua. Dạ em có đính kèm những hình dưới đây là mẫu báo cáo em đã xuất ra từ hệ thống. Giờ cách làm là làm thế nào để chia ra nhân viên đó đã bán được bao nhiêu sản phẩm và sản phẩm đó thuộc chiết khấu bao nhiêu. Chiết khấu thì có thể quy định bao gồm: 15%, 20%, 24%, 24.5%.. mỗi chiết khấu sẽ được đại diện cho danh mục thuộc tính của sản phẩm đó(em có đính kèm ảnh). Ví dụ được 2 sản phẩm thì có thể gộp cùng chiết khấu của một sản phẩm đó dựa theo tên của nhân viên đó. Tương tự với những nhân viên khác cũng vậy.. Có 2 loại hàng tiêu dùng là: Hàng BTCom và Hàng cty PHBC. Mỗi loại mặt hàng sẽ chia ra khác nhau để tránh tính nhầm lẫn. Dựa theo file gốc xuất ra từ hệ thống để có thể biết được nhân viên đó bán được bao nhiêu sản phẩm, theo từng loại chiết khấu nào. Em thật sự không biết cách tách và gọi hàm trong VBA thể nào, vì đây cũng là công việc gấp mà e cũng không có nhiều thời gian để nghiên cứu.. Em thì làm bên android, nhưng em nghĩ không thể thực hiện được vì nó khá rườm rà, và rắc rối cho người thực hiện sau này. Nên em nghĩ làm trên excel là cách nhanh và hiệu quả nhất, để chỉ cần click chọn theo danh mục sản phẩm thì sẽ tự động tính luôn ạ. Vì sau này nếu làm xong thì em sẽ phải hướng dẫn lại cho dưới đơn vị cho họ làm ạ. Em nhờ các anh đi trước giúp đỡ ạ. Em cảm ơn nhiều ạ !

Dữ liệu quan trọng gởi bằng file ảnh !!! Không ai nhập lại dùm bạn
Gởi lại file gồm tất cả dữ liệu ban đầu, ví dụ kết quả mong muốn và giải thích cách xử lý theo ví dụ

 

[LearningExcel]

Dữ liệu quan trọng gởi bằng file ảnh !!! Không ai nhập lại dùm bạn
Gởi lại file gồm tất cả dữ liệu ban đầu, ví dụ kết quả mong muốn và giải thích cách xử lý theo ví dụ

Dạ vâng, đây là lần đầu đăng bài nhờ các anh giúp nên sai sót mong anh bỏ qua ạ.
Em xin gửi anh file em đã tổng hợp lại trong file excel ạ.
Em chân thành cảm ơn ạ

 

[HieuCD]

Dạ vâng, đây là lần đầu đăng bài nhờ các anh giúp nên sai sót mong anh bỏ qua ạ.
Em xin gửi anh file em đã tổng hợp lại trong file excel ạ.
Em chân thành cảm ơn ạ

Tên sheet không nên dùng tiếng Việt có dấu, chỉnh thống nhất cấu trúc sheet tỷ lệ và vài chổ chưa chuẩn

Sub XYZ()
  Dim sArr(), Arr, res(), Dic As Object, tKey$, tmp$
  Dim sR&, sC&, n&, i&, j&, k&
 
  Set Dic = CreateObject("scripting.dictionary")
  With Sheets("Report")
    sArr = .Range("A1:J2").Value
  End With
  sR = UBound(sArr): sC = UBound(sArr, 2)
  sArr(2, sC) = "20%"
  For j = 2 To sC
    If sArr(1, j) <> Empty Then n = n + 1
    Dic.Add n & "|" & TachSo(sArr(2, j)), j
  Next j
 
  Arr = Array("", "NhomHangBT", "NhomHangPHBC", "HangDuoc")
  For n = 1 To UBound(Arr)
    With Sheets(Arr(n))
      sR = .Range("A" & Rows.Count).End(xlUp).Row
      sC = .Cells(1, Columns.Count).End(xlToLeft).Column
      sArr = .Range("A1").Resize(sR, sC).Value
      For j = 3 To sC
        sArr(1, j) = Dic.Item(n & "|" & TachSo(sArr(1, j)))
      Next j
      For i = 2 To sR
        tKey = sArr(i, 1)
        If tKey <> Empty Then
          If Dic.exists(tKey) = False Then
            For j = 3 To sC
              If LCase(sArr(i, j)) = "x" Then
                Dic.Add tKey, sArr(1, j)
                Exit For
              End If
            Next j
          End If
        End If
      Next i
    End With
  Next n
 
  With Sheet3
    sArr = .Range("A5:Q" & .Range("C" & Rows.Count).End(xlUp).Row).Value
    sR = UBound(sArr)
    ReDim res(1 To sR, 1 To 10)
    For i = 1 To sR
      tmp = sArr(i, 1)
      If tmp <> Empty Then
        If IsNumeric(Mid(tmp, 1, 4)) = True Then
          k = k + 1
          res(k, 1) = Trim(Split(tmp, "-")(1))
        End If
      Else
        tmp = sArr(i, 3)
        If InStr(1, tmp, "-") > 0 Then
          j = Dic.Item(Trim(Split(tmp, "-")(0)))
          If j > 0 Then
            res(k, j) = res(k, j) + Val(Replace(sArr(i, 17), ",", ""))
          Else
            MsgBox ("Xem lai:" & Chr(10) & tmp)
          End If
        End If
      End If
    Next i
  End With
 
  With Sheets("Report")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 2 Then Range("A3:J" & i).ClearContents
    If k Then .Range("A3").Resize(k, 10) = res
  End With
End Sub

Private Function TachSo(ByVal tmp As String)
  Dim j&, n&, d&
  n = Len(tmp)
  If InStr(1, tmp, ",") > 0 Then d = 5 Else d = 3
  For j = 1 To n
    If IsNumeric(Mid(tmp, j, 1)) Then
      TachSo = Mid(tmp, j, d)
      Exit Function
    End If
  Next j
End Function

 

[LearningExcel]

Tên sheet không nên dùng tiếng Việt có dấu, chỉnh thống nhất cấu trúc sheet tỷ lệ và vài chổ chưa chuẩn

Sub XYZ()
  Dim sArr(), Arr, res(), Dic As Object, tKey$, tmp$
  Dim sR&, sC&, n&, i&, j&, k&

  Set Dic = CreateObject("scripting.dictionary")
  With Sheets("Report")
    sArr = .Range("A1:J2").Value
  End With
  sR = UBound(sArr): sC = UBound(sArr, 2)
  sArr(2, sC) = "20%"
  For j = 2 To sC
    If sArr(1, j) <> Empty Then n = n + 1
    Dic.Add n & "|" & TachSo(sArr(2, j)), j
  Next j

  Arr = Array("", "NhomHangBT", "NhomHangPHBC", "HangDuoc")
  For n = 1 To UBound(Arr)
    With Sheets(Arr(n))
      sR = .Range("A" & Rows.Count).End(xlUp).Row
      sC = .Cells(1, Columns.Count).End(xlToLeft).Column
      sArr = .Range("A1").Resize(sR, sC).Value
      For j = 3 To sC
        sArr(1, j) = Dic.Item(n & "|" & TachSo(sArr(1, j)))
      Next j
      For i = 2 To sR
        tKey = sArr(i, 1)
        If tKey <> Empty Then
          If Dic.exists(tKey) = False Then
            For j = 3 To sC
              If LCase(sArr(i, j)) = "x" Then
                Dic.Add tKey, sArr(1, j)
                Exit For
              End If
            Next j
          End If
        End If
      Next i
    End With
  Next n

  With Sheet3
    sArr = .Range("A5:Q" & .Range("C" & Rows.Count).End(xlUp).Row).Value
    sR = UBound(sArr)
    ReDim res(1 To sR, 1 To 10)
    For i = 1 To sR
      tmp = sArr(i, 1)
      If tmp <> Empty Then
        If IsNumeric(Mid(tmp, 1, 4)) = True Then
          k = k + 1
          res(k, 1) = Trim(Split(tmp, "-")(1))
        End If
      Else
        tmp = sArr(i, 3)
        If InStr(1, tmp, "-") > 0 Then
          j = Dic.Item(Trim(Split(tmp, "-")(0)))
          If j > 0 Then
            res(k, j) = res(k, j) + Val(Replace(sArr(i, 17), ",", ""))
          Else
            MsgBox ("Xem lai:" & Chr(10) & tmp)
          End If
        End If
      End If
    Next i
  End With

  With Sheets("Report")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 2 Then Range("A3:J" & i).ClearContents
    If k Then .Range("A3").Resize(k, 10) = res
  End With
End Sub

Private Function TachSo(ByVal tmp As String)
  Dim j&, n&, d&
  n = Len(tmp)
  If InStr(1, tmp, ",") > 0 Then d = 5 Else d = 3
  For j = 1 To n
    If IsNumeric(Mid(tmp, j, 1)) Then
      TachSo = Mid(tmp, j, d)
      Exit Function
    End If
  Next j
End Function

dạ em cảm ơn anh nhiều ạ.!