Lọc dữ liệu theo nhiều điều kiện

Liên hệ QC
A

Ai_Ma_Biet

Thành viên hoạt động
Tham gia
22/4/15
Bài viết
127
Được thích
20
Giới tính
Nam
Chào Anh, Chị.

Em có file chi tiết bán hàng của Khách hàng, Em muốn từ sheet "Chi tiet" lọc ra bảng tổng hợp bán hàng theo các điều kiện như bên dưới: Em cần kết quả như (Sheet "Loc". Nhờ Anh, Chị giúp Em công thức hay vba để tự chạy ghi điền Mã Khách Hàng và ngày.
Lọc theo Mã Khách hàng: gõ Mã Khách Hàng tại A1.
Gõ ngày cần lọc dữ liệu tại A2 và B2.
Từ B9 đến E50 sẽ hiện kết quả lọc theo:
Tên Sản Phẩm: Trong khoảng thời gian tại A2 đến B2 có phát sinh bao nhiêu Mã Sản Phẩm thì sẽ hiện ra hết.
Giá: Cùng 1 Sản Phẩm nhưng nếu có nhiều giá khác nhau thì sẽ hiện ra hết các giá.
Trọng Lượng: Tổng trọng lương theo Tên Sản Phẩm và Giá.
Số Hóa Đơn: Liệt kê ra tất cả các hóa đơn liên quan đến Tên Sản Phẩm và Giá.

Từ B9 đến E50 nếu những dòng nào không có dữ liệu thì sẽ ẩn đi sau khi lọc.

Cám ơn Anh, Chị.
Chúc cuối tuần vui vẻ.
 

File đính kèm

Lần chỉnh sửa cuối:
Ai_Ma_Biet đã viết:
Chào Anh, Chị.

Em có file chi tiết bán hàng của Khách hàng, Em muốn từ sheet "Chi tiet" lọc ra bảng tổng hợp bán hàng theo các điều kiện như bên dưới: Em cần kết quả như (Sheet "Loc". Nhờ Anh, Chị giúp Em công thức hay vba để tự chạy ghi điền Mã Khách Hàng và ngày.
Lọc theo Mã Khách hàng: gõ Mã Khách Hàng tại A1.
Gõ ngày cần lọc dữ liệu tại A2 và B2.
Từ B9 đến E50 sẽ hiện kết quả lọc theo:
Tên Sản Phẩm: Trong khoảng thời gian tại A2 đến B2 có phát sinh bao nhiêu Mã Sản Phẩm thì sẽ hiện ra hết.
Giá: Cùng 1 Sản Phẩm nhưng nếu có nhiều giá khác nhau thì sẽ hiện ra hết các giá.
Trọng Lượng: Tổng trọng lương theo Tên Sản Phẩm và Giá.
Số Hóa Đơn: Liệt kê ra tất cả các hóa đơn liên quan đến Tên Sản Phẩm và Giá.

Từ B9 đến E50 nếu những dòng nào không có dữ liệu thì sẽ ẩn đi sau khi lọc.

Cám ơn Anh, Chị.
Chúc cuối tuần vui vẻ.
Nhấp chuột vào đây để mở rộng...
Dùng VBA được không?
PHP: 
Public Sub s_Gpe()
Dim Dic As Object, sArr(), dArr()
Dim I As Long, J As Long, K As Long, R As Long, fDay As Long, eDay As Long, Rws As Long
Dim Txt As String, MaKH As String, SoHD As String
Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Sheets("Chi tiet").UsedRange.Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 5)
With Sheets("Loc")
    MaKH = .Range("A1").Value
    fDay = .Range("A2").Value
    eDay = .Range("B2").Value
    For I = 2 To R
        If sArr(I, 1) = MaKH Then
            If sArr(I, 4) >= fDay Then
                If sArr(I, 4) <= eDay Then
                    Txt = sArr(I, 2) & "#" & sArr(I, 6)
                    SoHD = sArr(I, 5)
                    If Not Dic.Exists(Txt) Then
                        K = K + 1
                        Dic.Item(Txt) = K
                        dArr(K, 1) = K
                        dArr(K, 2) = sArr(I, 2)
                        dArr(K, 3) = sArr(I, 6)
                        dArr(K, 4) = sArr(I, 3)
                        dArr(K, 5) = SoHD
                    Else
                        Rws = Dic.Item(Txt)
                        dArr(Rws, 4) = dArr(Rws, 4) + sArr(I, 3)
                        dArr(Rws, 5) = dArr(Rws, 5) & "; " & SoHD
                    End If
                End If
            End If
        End If
    Next I
    .Range("A9").Resize(1000, 5) = dArr
    If K Then .Range("A9").Resize(K, 5) = dArr
End With
Set Dic = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Ba Tê đã viết:
Dùng VBA được không?
PHP: 
Public Sub s_Gpe()
Dim Dic As Object, sArr(), dArr()
Dim I As Long, J As Long, K As Long, R As Long, fDay As Long, eDay As Long, Rws As Long
Dim Txt As String, MaKH As String, SoHD As String
Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Sheets("Chi tiet").UsedRange.Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 5)
With Sheets("Loc")
    MaKH = .Range("A1").Value
    fDay = .Range("A2").Value
    eDay = .Range("B2").Value
    For I = 2 To R
        If sArr(I, 1) = MaKH Then
            If sArr(I, 4) >= fDay Then
                If sArr(I, 4) <= eDay Then
                    Txt = sArr(I, 2) & "#" & sArr(I, 6)
                    SoHD = sArr(I, 5)
                    If Not Dic.Exists(Txt) Then
                        K = K + 1
                        Dic.Item(Txt) = K
                        dArr(K, 1) = K
                        dArr(K, 2) = sArr(I, 2)
                        dArr(K, 3) = sArr(I, 6)
                        dArr(K, 4) = sArr(I, 3)
                        dArr(K, 5) = SoHD
                    Else
                        Rws = Dic.Item(Txt)
                        dArr(Rws, 4) = dArr(Rws, 4) + sArr(I, 3)
                        dArr(Rws, 5) = dArr(Rws, 5) & "; " & SoHD
                    End If
                End If
            End If
        End If
    Next I
    .Range("A9").Resize(1000, 5) = dArr
    If K Then .Range("A9").Resize(K, 5) = dArr
End With
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Có cách nào khi thay đổi A1 thì code tự chạy không Thầy. Thầy xem thêm phần bên dưới giúp với:
Từ B9 đến E50 nếu những dòng nào không có dữ liệu thì sẽ ẩn đi sau khi lọc.
 

File đính kèm

Ba Tê đã viết:
Bạn xem file.
Nhấp chuột vào đây để mở rộng...
Cột số hóa đơn nếu có số 0 ở phía trước thì nó hay bị mất (có số bị mất có số không mất). Thầy sửa giúp Em cột đó mặc định lấy 7 ký tự nha Thầy.
Độ rộng cột hóa đơn cũng hay bị lỗi có khi nó rộng hơn dữ liệu mấy dòng. Hoặc dòng đó nó đang có nhiều hóa đơn mà đổi sang mã khách hàng khác ít số hóa đơn hơn nó cũng rộng như vậy chứ không tự giảm độ rộng lại

1587202425466.png
 
Ai_Ma_Biet đã viết:
Cột số hóa đơn nếu có số 0 ở phía trước thì nó hay bị mất (có số bị mất có số không mất). Thầy sửa giúp Em cột đó mặc định lấy 7 ký tự nha Thầy.
Độ rộng cột hóa đơn cũng hay bị lỗi có khi nó rộng hơn dữ liệu mấy dòng. Hoặc dòng đó nó đang có nhiều hóa đơn mà đổi sang mã khách hàng khác ít số hóa đơn hơn nó cũng rộng như vậy chứ không tự giảm độ rộng lại

View attachment 235944
Nhấp chuột vào đây để mở rộng...
Ai_Ma_Biet đã viết:
Cột số hóa đơn nếu có số 0 ở phía trước thì nó hay bị mất (có số bị mất có số không mất). Thầy sửa giúp Em cột đó mặc định lấy 7 ký tự nha Thầy.
Độ rộng cột hóa đơn cũng hay bị lỗi có khi nó rộng hơn dữ liệu mấy dòng. Hoặc dòng đó nó đang có nhiều hóa đơn mà đổi sang mã khách hàng khác ít số hóa đơn hơn nó cũng rộng như vậy chứ không tự giảm độ rộng lại

View attachment 235944
Nhấp chuột vào đây để mở rộng...
Đến đây là "hết vốn" rồi nhé.
 

File đính kèm

Ba Tê đã viết:
Đến đây là "hết vốn" rồi nhé.
Nhấp chuột vào đây để mở rộng...
Đâu có khác gì đâu Thầy. Nếu dòng nào có khoảng 6 dòng hóa đơn thì nó tự fix dòng, chứ còn cỡ 6 dòng hóa đơn trở lên là nó ý như hình em chụp, số hóa đơn vẫn bị mất số 0 (dòng nào chỉ có 1 số hóa đơn là bị mất).
 
Ai_Ma_Biet đã viết:
Đâu có khác gì đâu Thầy. Nếu dòng nào có khoảng 6 dòng hóa đơn thì nó tự fix dòng, chứ còn cỡ 6 dòng hóa đơn trở lên là nó ý như hình em chụp, số hóa đơn vẫn bị mất số 0 (dòng nào chỉ có 1 số hóa đơn là bị mất).
Nhấp chuột vào đây để mở rộng...
Vậy thì thua!
Máy tôi thì như vầy, đủ 7 ký tự số.
Hinh1.jpgHinh2.jpg
 
Lần chỉnh sửa cuối:
Anh,Chị giúp dùm công thức với.
 
Ai_Ma_Biet đã viết:
Anh,Chị giúp dùm công thức với.
Nhấp chuột vào đây để mở rộng...
Công thức Excel không làm được cột số hóa đơn
Chép code vào sheet Loc, thay đổi các ô nếu dữ liệu phù hợp code sẽ trả về kết quả
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim eRow&, tmp
  Application.EnableEvents = False
  tmp = Target.Address(0, 0)
  If tmp = "A1" Or tmp = "A2" Or tmp = "B2" Then
    eRow = Range("B" & Rows.Count).End(xlUp).Row
    If eRow > 8 Then Range("A9:E" & eRow).Clear
    If IsDate(Range("A2")) And IsDate(Range("B2")) Then
      If Range("B2") >= Range("A2") Then
        Call Loc(Range("A1").Value, Range("A2").Value, Range("B2").Value)
      End If
    End If
  End If
  Application.EnableEvents = True
End Sub

Private Sub Loc(ByVal MaKH$, ByVal fDay As Date, ByVal eDay As Date)
  Dim Dic As Object, sArr(), Res(), Res2() As String
  Dim sRow&, i&, j&, k&, ik&
  Dim iKey$, SoHD$

  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("Chi Tiet")
    sArr = .Range("A2", .Range("G" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 4)
  ReDim Res2(1 To sRow, 1 To 1)
 
  For i = 1 To sRow
    If (MaKH <> Empty) = (sArr(i, 1) = MaKH) Then
      If sArr(i, 4) >= fDay Then
        If sArr(i, 4) <= eDay Then
          iKey = sArr(i, 2) & "#" & sArr(i, 6)
          SoHD = sArr(i, 5)
          If Not Dic.Exists(iKey) Then
            k = k + 1
            Dic.Add iKey, k
            Res(k, 1) = k:            Res(k, 2) = sArr(i, 2)
            Res(k, 3) = sArr(i, 6):   Res(k, 4) = sArr(i, 3)
            Res2(k, 1) = SoHD
          Else
            ik = Dic.Item(iKey)
            Res(ik, 4) = Res(ik, 4) + sArr(i, 3)
            Res2(ik, 1) = Res2(ik, 1) & "; " & SoHD
          End If
        End If
      End If
    End If
  Next i
  If k Then
    Range("A9").Resize(k, 4) = Res
    Range("E9").Resize(k, 1) = Res2
  End If
  Set Dic = Nothing
End Sub
 
Ba Tê đã viết:
Vậy thì thua!
Máy tôi thì như vầy, đủ 7 ký tự số.
View attachment 235976View attachment 235977
Nhấp chuột vào đây để mở rộng...
Thầy ơi. Nếu Em thêm 1 cột sau cột STT thì code này sửa như thế nào vậy Thầy. Em mò hoài mà không được.

Cuối cùng thì cũng được.
Mã: 
Option Explicit


Public Sub s_Gpe()
Dim Dic As Object, sArr(), dArr()
Dim I As Long, J As Long, K As Long, R As Long, fDay As Long, eDay As Long, Rws As Long
Dim Txt As String, MaKH As String, SoHD As String
Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Sheets("Chi tiet").UsedRange.Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 6)
With Sheets("Loc")
    .Rows("9:50").EntireRow.Hidden = False
    .Range("A9:A50").Resize(, 6).ClearContents
    MaKH = .Range("A1").Value
    fDay = .Range("A2").Value
    eDay = .Range("B2").Value
    For I = 2 To R
        If sArr(I, 1) = MaKH Then
            If sArr(I, 4) >= fDay Then
                If sArr(I, 4) <= eDay Then
                    Txt = sArr(I, 2) & "#" & sArr(I, 6)
                    SoHD = Format(sArr(I, 5), "0000000")
                    If Not Dic.Exists(Txt) Then
                        K = K + 1
                        Dic.Item(Txt) = K
                        dArr(K, 1) = K
                        dArr(K, 2) = sArr(I, 2)
                        dArr(K, 3) = sArr(I, 6)
                        dArr(K, 4) = sArr(I, 3)
                        dArr(K, 6) = SoHD
                    Else
                        Rws = Dic.Item(Txt)
                        dArr(Rws, 5) = dArr(Rws, 5) + sArr(I, 3)
                        dArr(Rws, 6) = dArr(Rws, 6) & "; " & SoHD
                    End If
                End If
            End If
        End If
    Next I
    If K Then
        .Range("A9").Resize(K, 6) = dArr
        .Rows("9:" & K + 8).EntireRow.AutoFit
    End If
    .Rows(K + 9 & ":50").EntireRow.Hidden = True
End With
Set Dic = Nothing
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
HieuCD đã viết:
Công thức Excel không làm được cột số hóa đơn
Chép code vào sheet Loc, thay đổi các ô nếu dữ liệu phù hợp code sẽ trả về kết quả
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim eRow&, tmp
  Application.EnableEvents = False
  tmp = Target.Address(0, 0)
  If tmp = "A1" Or tmp = "A2" Or tmp = "B2" Then
    eRow = Range("B" & Rows.Count).End(xlUp).Row
    If eRow > 8 Then Range("A9:E" & eRow).Clear
    If IsDate(Range("A2")) And IsDate(Range("B2")) Then
      If Range("B2") >= Range("A2") Then
        Call Loc(Range("A1").Value, Range("A2").Value, Range("B2").Value)
      End If
    End If
  End If
  Application.EnableEvents = True
End Sub

Private Sub Loc(ByVal MaKH$, ByVal fDay As Date, ByVal eDay As Date)
  Dim Dic As Object, sArr(), Res(), Res2() As String
  Dim sRow&, i&, j&, k&, ik&
  Dim iKey$, SoHD$

  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("Chi Tiet")
    sArr = .Range("A2", .Range("G" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To sRow, 1 To 4)
  ReDim Res2(1 To sRow, 1 To 1)

  For i = 1 To sRow
    If (MaKH <> Empty) = (sArr(i, 1) = MaKH) Then
      If sArr(i, 4) >= fDay Then
        If sArr(i, 4) <= eDay Then
          iKey = sArr(i, 2) & "#" & sArr(i, 6)
          SoHD = sArr(i, 5)
          If Not Dic.Exists(iKey) Then
            k = k + 1
            Dic.Add iKey, k
            Res(k, 1) = k:            Res(k, 2) = sArr(i, 2)
            Res(k, 3) = sArr(i, 6):   Res(k, 4) = sArr(i, 3)
            Res2(k, 1) = SoHD
          Else
            ik = Dic.Item(iKey)
            Res(ik, 4) = Res(ik, 4) + sArr(i, 3)
            Res2(ik, 1) = Res2(ik, 1) & "; " & SoHD
          End If
        End If
      End If
    End If
  Next i
  If k Then
    Range("A9").Resize(k, 4) = Res
    Range("E9").Resize(k, 1) = Res2
  End If
  Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...

Anh làm công thức giúp Em nha. Cột số HĐ Em sẽ dùng cách khác.
 
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

N
Cách đánh số thứ tự không liên tục (đánh số lại từ đầu khi cột bên cạnh có giá trị)
Trả lời
10
Đọc
206
Hoàng Tuấn 868
H
V
  • Question Question
Tách số liệu từ bảng tính ngang theo điều kiện
Trả lời
0
Đọc
13
vanlinh_2904
V
khang2303
Lỗi đảo lộn ngày tháng khi Merger sang Word
Trả lời
4
Đọc
42
vanle33
vanle33
Q
Hỏi về công thức dò giá
Trả lời
1
Đọc
29
Hoàng Tuấn 868
H
saobekhonglac
Tạo form vòng quay may mắn
    • Thích
2
Trả lời
34
Đọc
15K
kllua96
K
phatnguyen7301
  • Question Question
Tạo âm thanh khi nhấn vào một phím
Trả lời
4
Đọc
182
kllua96
K
X
  • Question Question
Giúp sửa code để gõ chữ thường ra được cả chữ hoa khi tìm kiếm
Trả lời
7
Đọc
59
HeSanbi
HeSanbi
quangminhici
Tặng Addin Word xuất Mail Merge có chức năng cắt ra nhiều file và gửi mail.
    • Thích
    • Yêu thích
Trả lời
17
Đọc
2K
Võ Việt Tuyến
V
H
file bị lỗi value khi copy qua file mới.
Trả lời
1
Đọc
54
Hoàng Tuấn 868
H
Thanh12Loan
Xin chào các bác. Em bị lỗi khung hiển thị excell Spreadsheet.
Trả lời
2
Đọc
68
Thanh12Loan
Thanh12Loan
LuuAnh980
Tham chiếu trong công thức bị giảm.
Trả lời
4
Đọc
87
Hoàng Tuấn 868
H
GPE-Trợ Lý
[GPE] TALK SHOW HÀM QUERY - BÍ KÍP BIẾN DỮ LIỆU KHỔNG LỒ THÀNH THÔNG TIN HỮU ÍCH TRONG TÍCH TẮC
    • Thích
    • Yêu thích
Trả lời
3
Đọc
1K
VetMini
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Cảm ơn
Trả lời
2
Đọc
673
PhanTuHuong
PhanTuHuong
hoamattroicoi
Trích xuất file *.xml sang Excel cho hóa đơn điện tử áp dụng nghị định 123/2020
    • Thích
    • Yêu thích
    • Cảm ơn
5 6 7
Trả lời
123
Đọc
31K
kunkoi9390
K
vanle33
File không thao tác gì khi mở ra vẫn hỏi lưu lại khi tắt đi.
Trả lời
9
Đọc
155
hoangtuan.net
hoangtuan.net
H
Cách tạo nhắc nhở trong excel và tự động mở file khi có nhắc nhở
Trả lời
18
Đọc
6K
ongke0711
ongke0711
G
Chuyển Data từ hàng và cột về dạng cột
Trả lời
11
Đọc
186
ptm0412
ptm0412
P
Tại sao khi đánh số thì bị mất hai số cuối
Trả lời
4
Đọc
18K
vanle33
vanle33
HeSanbi
  • Đã giải quyết
LocalizeXL v1.71 - Làm nổi bật ô đang chọn và cuộn trang tự động
    • Thích
    • Yêu thích
2 3
Trả lời
58
Đọc
9K
HeSanbi
HeSanbi
linhvu2807
Lỗi hàm công thức Querry
Trả lời
0
Đọc
61
linhvu2807
linhvu2807
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
Chúc mừng năm mới.
Back
Top Bottom