Nhờ các bác tính tổng theo nhiêu điều kiện

nvtnet · 5/5/19

Nhờ các bác giúp đỡ ạ, yêu câù cần giúp đỡ em gửi theo file

be_09 · 5/5/19

nvtnet đã viết:
EM GỬI FILE VÀ YÊU CẦU CẦN GIÚP ĐỠ, MONG CÁC BÁC GIÚP Ạ

1/ Đọc nội quy để hiểu mình vi phạm cái gì.
2/ Sheet NHẬP PHIẾU phải có cột Loại mặt hàng để phân biệt loại Đồ uống và nhu yếu phẩm rồi sử dụng PivotTable.
3/ Trong File có sử dụng code sao không hỏi trong Box Lập trình với VBA.

nvtnet · 6/5/19

be09 đã viết:
1/ Đọc nội quy để hiểu mình vi phạm cái gì.
2/ Sheet NHẬP PHIẾU phải có cột Loại mặt hàng để phân biệt loại Đồ uống và nhu yếu phẩm rồi sử dụng PivotTable.
3/ Trong File có sử dụng code sao không hỏi trong Box Lập trình với VBA.

View attachment 216496

Dạ vâng, em không để ý nên biết hoa, em sẽ chỉnh lại, vậy để em đang sang box kia ạ

leonguyenz · 6/5/19

nvtnet đã viết:
Nhờ các bác giúp đỡ ạ, yêu câù cần giúp đỡ em gửi theo file

Tham khảo code và file đính kèm.

Mã:

Sub Button2_Click()
Dim BGia As Range, NPhieu As Range, i As Long, j As Long, reS()
Dim Dic As Object, xFBG As Range, Tmp As String, LoaiMH As Byte
Set BGia = Sheet1.Range("B2:B" & Sheet1.Range("B65535").End(xlUp).Row)
Set NPhieu = Sheet2.Range("B2:K" & Sheet2.Range("F65535").End(xlUp).Row)
ReDim reS(1 To NPhieu.Rows.Count, 1 To 5)
Set Dic = CreateObject("Scripting.Dictionary")
Sheet3.Range("A2:E65535").ClearContents
i = 1
Do While i <= NPhieu.Rows.Count
    If NPhieu(i, 2) <> "" Then
        Tmp = NPhieu(i, 2)
        If Not Dic.Exists(Tmp) Then
            j = j + 1: Dic.Add Tmp, j
            reS(j, 1) = Tmp: reS(j, 2) = NPhieu(i, 3)
            Set xFBG = BGia.Find(NPhieu(i, 5), , , 1)
            If Not xFBG Is Nothing Then
                LoaiMH = IIf(xFBG.Offset(, 4) = Sheet3.Range("C1"), 3, _
                    IIf(xFBG.Offset(, 4) = Sheet3.Range("D1"), 4, 5))
                reS(j, LoaiMH) = NPhieu(i, 10)
            End If
        Else
            Set xFBG = BGia.Find(NPhieu(i, 5), , , 1)
            If Not xFBG Is Nothing Then
                LoaiMH = IIf(xFBG.Offset(, 4) = Sheet3.Range("C1"), 3, _
                    IIf(xFBG.Offset(, 4) = Sheet3.Range("D1"), 4, 5))
                reS(Dic.Item(Tmp), LoaiMH) = _
                    reS(Dic.Item(Tmp), LoaiMH) + NPhieu(i, 10)
            End If
        End If
    Else
        Set xFBG = BGia.Find(NPhieu(i, 5), , , 1)
        If Not xFBG Is Nothing Then
            LoaiMH = IIf(xFBG.Offset(, 4) = Sheet3.Range("C1"), 3, _
                IIf(xFBG.Offset(, 4) = Sheet3.Range("D1"), 4, 5))
            reS(Dic.Item(Tmp), LoaiMH) = _
                reS(Dic.Item(Tmp), LoaiMH) + NPhieu(i, 10)
        End If
    End If
    i = i + 1
Loop
Sheet3.Range("A2").Resize(j, 5) = reS
End Sub

hocexcel_1991 · 6/5/19

nvtnet đã viết:
Nhờ các bác giúp đỡ ạ, yêu câù cần giúp đỡ em gửi theo file

Gửi bạn file công thức tham khảo, dùng cột phụ

Phan Thế Hiệp · 6/5/19

hocexcel_1991 đã viết:
Gửi bạn file công thức tham khảo, dùng cột phụ

(Góp sức với em) Thay vì dùng cột phụ L, dùng thử đoạn công thức sau sẽ không cần bất cứ cột phụ nào:

Mã:

(T(OFFSET('NHẬP PHIẾU'!$C$1,AGGREGATE(15,6,ROW($1:$95)/('NHẬP PHIẾU'!$C$2:$C$96<>""),COUNTIF(OFFSET('NHẬP PHIẾU'!$C$2,,,ROW($1:$95)),"<>")),))=$A2)

Thay cho đoạn trong công thức Sumproduct() của em:
('NHẬP PHIẾU'!$L$2:$L$96=$A2)

Thân

nvtnet · 6/5/19

leonguyenz đã viết:

Tham khảo code và file đính kèm.

Mã:

Sub Button2_Click()
Dim BGia As Range, NPhieu As Range, i As Long, j As Long, reS()
Dim Dic As Object, xFBG As Range, Tmp As String, LoaiMH As Byte
Set BGia = Sheet1.Range("B2:B" & Sheet1.Range("B65535").End(xlUp).Row)
Set NPhieu = Sheet2.Range("B2:K" & Sheet2.Range("F65535").End(xlUp).Row)
ReDim reS(1 To NPhieu.Rows.Count, 1 To 5)
Set Dic = CreateObject("Scripting.Dictionary")
Sheet3.Range("A2:E65535").ClearContents
i = 1
Do While i <= NPhieu.Rows.Count
    If NPhieu(i, 2) <> "" Then
        Tmp = NPhieu(i, 2)
        If Not Dic.Exists(Tmp) Then
            j = j + 1: Dic.Add Tmp, j
            reS(j, 1) = Tmp: reS(j, 2) = NPhieu(i, 3)
            Set xFBG = BGia.Find(NPhieu(i, 5), , , 1)
            If Not xFBG Is Nothing Then
                LoaiMH = IIf(xFBG.Offset(, 4) = Sheet3.Range("C1"), 3, _
                    IIf(xFBG.Offset(, 4) = Sheet3.Range("D1"), 4, 5))
                reS(j, LoaiMH) = NPhieu(i, 10)
            End If
        Else
            Set xFBG = BGia.Find(NPhieu(i, 5), , , 1)
            If Not xFBG Is Nothing Then
                LoaiMH = IIf(xFBG.Offset(, 4) = Sheet3.Range("C1"), 3, _
                    IIf(xFBG.Offset(, 4) = Sheet3.Range("D1"), 4, 5))
                reS(Dic.Item(Tmp), LoaiMH) = _
                    reS(Dic.Item(Tmp), LoaiMH) + NPhieu(i, 10)
            End If
        End If
    Else
        Set xFBG = BGia.Find(NPhieu(i, 5), , , 1)
        If Not xFBG Is Nothing Then
            LoaiMH = IIf(xFBG.Offset(, 4) = Sheet3.Range("C1"), 3, _
                IIf(xFBG.Offset(, 4) = Sheet3.Range("D1"), 4, 5))
            reS(Dic.Item(Tmp), LoaiMH) = _
                reS(Dic.Item(Tmp), LoaiMH) + NPhieu(i, 10)
        End If
    End If
    i = i + 1
Loop
Sheet3.Range("A2").Resize(j, 5) = reS
End Sub

nhưng cho em hỏi thêm: vì sẽ có những người giống tên nhau, nên em phân biệt thêm cột đội (trùng tên, đội là rất hiếm), bác giúp thêm là phân biệt theo đội nữa được không ạ, file ví dụ em gửi len em quên không đưa trường hợp này vào.

Bài đã được tự động gộp: 6/5/19

hocexcel_1991 đã viết:
Gửi bạn file công thức tham khảo, dùng cột phụ

Phan Thế Hiệp đã viết:
(Góp sức với em) Thay vì dùng cột phụ L, dùng thử đoạn công thức sau sẽ không cần bất cứ cột phụ nào:

Mã:

(T(OFFSET('NHẬP PHIẾU'!$C$1,AGGREGATE(15,6,ROW($1:$95)/('NHẬP PHIẾU'!$C$2:$C$96<>""),COUNTIF(OFFSET('NHẬP PHIẾU'!$C$2,,,ROW($1:$95)),"<>")),))=$A2)

Thay cho đoạn trong công thức Sumproduct() của em:
('NHẬP PHIẾU'!$L$2:$L$96=$A2)

Thân

dạ cảm ơn hai bác ạ, để em vận dụng thử, nhưng em quên mất là có những người trùng họ và tên, nên sẽ dùng thêm lựa chọn đội để hạn chế bì trùng lặp (thông tin nhập vào khá ít nên cũng không biết làm sao để hạn chế bị trùng lặp, nên chỉ thêm tên đội để hạn chế thôi ạ)

Phan Thế Hiệp · 7/5/19

nvtnet đã viết:
nhưng em quên mất là có những người trùng họ và tên, nên sẽ dùng thêm lựa chọn đội để hạn chế bì trùng lặp (thông tin nhập vào khá ít nên cũng không biết làm sao để hạn chế bị trùng lặp, nên chỉ thêm tên đội để hạn chế thôi ạ)

Vậy, tại sao bạn không tạo "Mã" thay vì tìm tên, hoặc có thêm cột chứa "số CMND" của nhân viên đó, rồi dựa trên CMND mà tính toán sẽ không có chuyện trùng lặp.

Thân

HieuCD · 7/5/19

Phan Thế Hiệp đã viết:
Vậy, tại sao bạn không tạo "Mã" thay vì tìm tên, hoặc có thêm cột chứa "số CMND" của nhân viên đó, rồi dựa trên CMND mà tính toán sẽ không có chuyện trùng lặp.

Thân

Dựng chòi bán hàng cho công nhân yêu cầu lấy số CMND hơi khó. Khà Khà, Chúc bạn 1 ngày vui

nvtnet đã viết:
nhưng cho em hỏi thêm: vì sẽ có những người giống tên nhau, nên em phân biệt thêm cột đội (trùng tên, đội là rất hiếm), bác giúp thêm là phân biệt theo đội nữa được không ạ, file ví dụ em gửi len em quên không đưa trường hợp này vào.

Bài đã được tự động gộp: 6/5/19

dạ cảm ơn hai bác ạ, để em vận dụng thử, nhưng em quên mất là có những người trùng họ và tên, nên sẽ dùng thêm lựa chọn đội để hạn chế bì trùng lặp (thông tin nhập vào khá ít nên cũng không biết làm sao để hạn chế bị trùng lặp, nên chỉ thêm tên đội để hạn chế thôi ạ)

Chạy code

Mã:

Sub GPE()
  Dim SanPham(), Phieu(), Res(), Dic As Object
  Dim i As Long, ik As Long, j As Long, sRow As Long
  Dim iKey As String
 
  SanPham = Sheet1.Range("B2:F" & Sheet1.Range("B1000000").End(xlUp).Row).Value
  Phieu = Sheet2.Range("C2:K" & Sheet2.Range("F1000000").End(xlUp).Row).Value
  sRow = UBound(Phieu)
  ReDim Res(1 To sRow, 1 To 5)
  Set Dic = CreateObject("Scripting.Dictionary")
 
  For i = 1 To UBound(SanPham)
    iKey = UCase(SanPham(i, 1))
    If Dic.exists(iKey) = False Then
      If InStr(1, SanPham(i, 5), "Nhu") Then Dic.Add iKey, 5 Else Dic.Add iKey, 4
    End If
  Next i
  For i = 1 To sRow
    If Len(Phieu(i, 1)) > 0 Then iKey = Phieu(i, 1) & "#" & Phieu(i, 2)
    If Dic.exists(iKey) = False Then
      k = k + 1
      Dic.Add iKey, k
      Res(k, 1) = k: Res(k, 2) = Phieu(i, 1): Res(k, 3) = Phieu(i, 2)
    End If
    ik = Dic.Item(iKey)
    j = Dic.Item(UCase(Phieu(i, 4)))
    Res(ik, j) = Res(ik, j) + Phieu(i, 9)
  Next i
  With Sheet3
    i = .Range("B1000000").End(xlUp).Row
    If i > 1 Then .Range("A2:E" & i).Clear
    .Range("A2").Resize(k, 5) = Res
    .Range("A2").Resize(k, 5).Borders.LineStyle = 1
  End With
End Sub

nvtnet · 8/5/19

mấy hôm nay bận quá không vào được mong các bác thông cảm, cảm ơn các bác đã rất nhiệt tình, có lẻ phảm làm theo hướng tạo mã số cho từng người. cảm ơn các bác rất nhiều ạ

Bài đã được tự động gộp: 8/5/19

HieuCD đã viết:

Dựng chòi bán hàng cho công nhân yêu cầu lấy số CMND hơi khó. Khà Khà, Chúc bạn 1 ngày vui

Chạy code

Mã:

Sub GPE()
  Dim SanPham(), Phieu(), Res(), Dic As Object
  Dim i As Long, ik As Long, j As Long, sRow As Long
  Dim iKey As String

  SanPham = Sheet1.Range("B2:F" & Sheet1.Range("B1000000").End(xlUp).Row).Value
  Phieu = Sheet2.Range("C2:K" & Sheet2.Range("F1000000").End(xlUp).Row).Value
  sRow = UBound(Phieu)
  ReDim Res(1 To sRow, 1 To 5)
  Set Dic = CreateObject("Scripting.Dictionary")

  For i = 1 To UBound(SanPham)
    iKey = UCase(SanPham(i, 1))
    If Dic.exists(iKey) = False Then
      If InStr(1, SanPham(i, 5), "Nhu") Then Dic.Add iKey, 5 Else Dic.Add iKey, 4
    End If
  Next i
  For i = 1 To sRow
    If Len(Phieu(i, 1)) > 0 Then iKey = Phieu(i, 1) & "#" & Phieu(i, 2)
    If Dic.exists(iKey) = False Then
      k = k + 1
      Dic.Add iKey, k
      Res(k, 1) = k: Res(k, 2) = Phieu(i, 1): Res(k, 3) = Phieu(i, 2)
    End If
    ik = Dic.Item(iKey)
    j = Dic.Item(UCase(Phieu(i, 4)))
    Res(ik, j) = Res(ik, j) + Phieu(i, 9)
  Next i
  With Sheet3
    i = .Range("B1000000").End(xlUp).Row
    If i > 1 Then .Range("A2:E" & i).Clear
    .Range("A2").Resize(k, 5) = Res
    .Range("A2").Resize(k, 5).Borders.LineStyle = 1
  End With
End Sub

cảm ơn bác ạ, thêm lựa chọn đội này có lẽ ổn lắm rồi ạ, vẫn có khả năng trùng nhưng rất hiếm

nvtnet · 9/5/19

em cho vào file đang dùng nhưng bị như sau, mong các bác xem nó bị lỗi gì, em thì không biết gì về VBA cả hi hi

HieuCD · 9/5/19

nvtnet đã viết:
em cho vào file đang dùng nhưng bị như sau, mong các bác xem nó bị lỗi gì, em thì không biết gì về VBA cả hi hi

Tên sheet không nên dùng tiếng Việt, mình đổi tên sheet trong file và gọi tên sheet trong code để bạn dể hình dung

Mã:

Sub GPE()
  Dim SanPham(), Phieu(), Res(), Dic As Object
  Dim i As Long, ik As Long, j As Long, sRow As Long
  Dim iKey As String
 
  SanPham = Sheets("BangGia").Range("B2:F" & Sheet1.Range("B1000000").End(xlUp).Row).Value
  Phieu = Sheets("NhapPhieu").Range("C2:K" & Sheet2.Range("F1000000").End(xlUp).Row).Value
  sRow = UBound(Phieu)
  ReDim Res(1 To sRow, 1 To 5)
  Set Dic = CreateObject("Scripting.Dictionary")
 
  For i = 1 To UBound(SanPham)
    iKey = UCase(SanPham(i, 1))
    If Dic.exists(iKey) = False Then
      If InStr(1, SanPham(i, 5), "Nhu") Then Dic.Add iKey, 5 Else Dic.Add iKey, 4
    End If
  Next i
  For i = 1 To sRow
    If Len(Phieu(i, 1)) > 0 Then iKey = Phieu(i, 1) & "#" & Phieu(i, 2)
    If Dic.exists(iKey) = False Then
      k = k + 1
      Dic.Add iKey, k
      Res(k, 1) = k: Res(k, 2) = Phieu(i, 1): Res(k, 3) = Phieu(i, 2)
    End If
    ik = Dic.Item(iKey)
    j = Dic.Item(UCase(Phieu(i, 4)))
    Res(ik, j) = Res(ik, j) + Phieu(i, 9)
  Next i
  With Sheets("TinhVuot")
    i = .Range("B1000000").End(xlUp).Row
    If i > 1 Then .Range("A2:E" & i).Clear
    .Range("A2").Resize(k, 5) = Res
    .Range("A2").Resize(k, 5).Borders.LineStyle = 1
  End With
End Sub

nvtnet · 9/5/19

HieuCD đã viết:

Tên sheet không nên dùng tiếng Việt, mình đổi tên sheet trong file và gọi tên sheet trong code để bạn dể hình dung

Mã:

Sub GPE()
  Dim SanPham(), Phieu(), Res(), Dic As Object
  Dim i As Long, ik As Long, j As Long, sRow As Long
  Dim iKey As String

  SanPham = Sheets("BangGia").Range("B2:F" & Sheet1.Range("B1000000").End(xlUp).Row).Value
  Phieu = Sheets("NhapPhieu").Range("C2:K" & Sheet2.Range("F1000000").End(xlUp).Row).Value
  sRow = UBound(Phieu)
  ReDim Res(1 To sRow, 1 To 5)
  Set Dic = CreateObject("Scripting.Dictionary")

  For i = 1 To UBound(SanPham)
    iKey = UCase(SanPham(i, 1))
    If Dic.exists(iKey) = False Then
      If InStr(1, SanPham(i, 5), "Nhu") Then Dic.Add iKey, 5 Else Dic.Add iKey, 4
    End If
  Next i
  For i = 1 To sRow
    If Len(Phieu(i, 1)) > 0 Then iKey = Phieu(i, 1) & "#" & Phieu(i, 2)
    If Dic.exists(iKey) = False Then
      k = k + 1
      Dic.Add iKey, k
      Res(k, 1) = k: Res(k, 2) = Phieu(i, 1): Res(k, 3) = Phieu(i, 2)
    End If
    ik = Dic.Item(iKey)
    j = Dic.Item(UCase(Phieu(i, 4)))
    Res(ik, j) = Res(ik, j) + Phieu(i, 9)
  Next i
  With Sheets("TinhVuot")
    i = .Range("B1000000").End(xlUp).Row
    If i > 1 Then .Range("A2:E" & i).Clear
    .Range("A2").Resize(k, 5) = Res
    .Range("A2").Resize(k, 5).Borders.LineStyle = 1
  End With
End Sub

nhưng khi chuyển sheet sang file mới (di chuyển hoặc sao) thì code có phải chỉnh sửa gì không ạ, em chèn code vào, file cũ cũng không có tiếng việt nhưng không chạy, bị lỗi như vậy

HieuCD · 9/5/19

nvtnet đã viết:
nhưng khi chuyển sheet sang file mới (di chuyển hoặc sao) thì code có phải chỉnh sửa gì không ạ, em chèn code vào, file cũ cũng không có tiếng việt nhưng không chạy, bị lỗi như vậy

Bạn chỉnh tên sheet mới trong các lệnh:
Sheets("tensheet"). .....

nvtnet · 9/5/19

HieuCD đã viết:
Bạn chỉnh tên sheet mới trong các lệnh:
Sheets("tensheet"). .....

dạ cảm ơn bác để em làm thử ạ

Nhờ các bác tính tổng theo nhiêu điều kiện

Thành viên thường trực

File đính kèm

Biên Hòa, Đồng Nai

Thành viên thường trực

Thành viên gạo cội

File đính kèm

Bắt đầu học Excel

File đính kèm

-⍟-

Thành viên thường trực

-⍟-

Chuyên gia GPE

File đính kèm

Thành viên thường trực

Thành viên thường trực

File đính kèm

Chuyên gia GPE

File đính kèm

Thành viên thường trực

Chuyên gia GPE

Thành viên thường trực

Đếm ngược thời gian