Nhờ code vba trích lọc dữ liệu (1 người xem)

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)
G

giaiphapexcel00

Thành viên mới
Tham gia
19/7/17
Bài viết
5
Được thích
0
Giới tính
Nam
Em có bảng tính như sau: sheet1 và sheet2. Em muốn trích lọc tên KH, với điều kiện Loại hàng trên 1 khách hàng mua, nghĩa là sau khi countif xong, nếu lớn hơn 1 sẽ trích lọc ra tên KH từ sheet1. Loại hàng chỉ có 1 khách mua hoặc không có khách mua sẽ không cần trích lọc tên KH. Nhờ các anh chị giúp đỡ nhé.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
giaiphapexcel00 đã viết:
Em có bảng tính như sau: sheet1 và sheet2. Em muốn trích lọc tên KH, với điều kiện Loại hàng trên 1 khách hàng mua, nghĩa là sau khi countif xong, nếu lớn hơn 1 sẽ trích lọc ra tên KH từ sheet1. Loại hàng chỉ có 1 khách mua hoặc không có khách mua sẽ không cần trích lọc tên KH. Nhờ các anh chị giúp đỡ nhé.
Nhấp chuột vào đây để mở rộng...
Bạn muốn dùng CT hay VBA!!!
 
Upvote 0
Mình muốn dùng VBA à, mà không rành lắm nên nhờ các anh chị viết dùm đoạn code đơn giản để sử dụng cho công việc tại nhà. Cảm ơn nhiều nhé!
 
Upvote 0
giaiphapexcel00 đã viết:
Em có bảng tính như sau: sheet1 và sheet2. Em muốn trích lọc tên KH, với điều kiện Loại hàng trên 1 khách hàng mua, nghĩa là sau khi countif xong, nếu lớn hơn 1 sẽ trích lọc ra tên KH từ sheet1. Loại hàng chỉ có 1 khách mua hoặc không có khách mua sẽ không cần trích lọc tên KH. Nhờ các anh chị giúp đỡ nhé.
Nhấp chuột vào đây để mở rộng...
Cái này sẽ code được thui. Nhưng mình nghĩ là bạn nên bố trí lại cấu trúc dữ liệu.
 
Upvote 0
giaiphapexcel00 đã viết:
Mình muốn dùng VBA à, mà không rành lắm nên nhờ các anh chị viết dùm đoạn code đơn giản để sử dụng cho công việc tại nhà. Cảm ơn nhiều nhé!
Nhấp chuột vào đây để mở rộng...
Bạn dùng code này thử xem:
PHP: 
Sub loc()
Dim num1 As Long, num2 As Long, num3 As Long, num4 As Long, rng As Range, sfin As Range, arr1, arr2
arr1 = Sheets("sheet2").Range("A3:B" & Sheets("sheet2").[A60000].End(xlUp).Row)
ReDim arr2(1 To UBound(arr1, 1), 1 To 4)
num3 = Sheets("sheet1").[A60000].End(xlUp).Row - 2
Set rng = Sheets("sheet1").[B2:E2]
For num1 = 1 To UBound(arr1)
    num2 = 0
    For num4 = 1 To num3
        Set sfin = rng.Offset(num4).Find(arr1(num1, 1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)
        If Not sfin Is Nothing And arr1(num1, 2) > 1 Then
            num2 = num2 + 1
            arr2(num1, num2) = Sheets("sheet1").[A2].Offset(num4)
        End If
    Next num4
Next num1
Sheets("sheet2").[C3].Resize(UBound(arr1), 4) = arr2
End Sub
 
Upvote 0
eke_rula đã viết:
Bạn dùng code này thử xem:
PHP: 
Sub loc()
Dim num1 As Long, num2 As Long, num3 As Long, num4 As Long, rng As Range, sfin As Range, arr1, arr2
arr1 = Sheets("sheet2").Range("A3:B" & Sheets("sheet2").[A60000].End(xlUp).Row)
ReDim arr2(1 To UBound(arr1, 1), 1 To 4)
num3 = Sheets("sheet1").[A60000].End(xlUp).Row - 2
Set rng = Sheets("sheet1").[B2:E2]
For num1 = 1 To UBound(arr1)
    num2 = 0
    For num4 = 1 To num3
        Set sfin = rng.Offset(num4).Find(arr1(num1, 1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)
        If Not sfin Is Nothing And arr1(num1, 2) > 1 Then
            num2 = num2 + 1
            arr2(num1, num2) = Sheets("sheet1").[A2].Offset(num4)
        End If
    Next num4
Next num1
Sheets("sheet2").[C3].Resize(UBound(arr1), 4) = arr2
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn nên viết code với số cột của sheet1 và đặc biệt là sheet2 không biết trước sẽ tổng quát hơn
 
Upvote 0
HieuCD đã viết:
Bạn nên viết code với số cột của sheet1 và đặc biệt là sheet2 không biết trước sẽ tổng quát hơn
Nhấp chuột vào đây để mở rộng...
Em sửa lại như vầy được không anh?
PHP: 
Sub loc()
Dim num1 As Long, num2 As Long, num3 As Long, num4 As Long, num5 As Long, rng As Range, sfin As Range, arr1, arr2
arr1 = Sheets("sheet2").Range("A3:B" & Sheets("sheet2").[A60000].End(xlUp).Row)
num3 = Sheets("sheet1").[A60000].End(xlUp).Row - 2
ReDim arr2(1 To UBound(arr1, 1), 1 To num3)
For num1 = 1 To num3
    num5 = WorksheetFunction.Max(num5, Sheets("sheet1").Cells(num1 + 2, Columns.Count).End(xlToLeft).Column)
Next num1
Set rng = Sheets("sheet1").[B2].Resize(1, num5 - 1)
For num1 = 1 To UBound(arr1)
    num2 = 0
    For num4 = 1 To num3
        Set sfin = rng.Offset(num4).Find(arr1(num1, 1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)
        If Not sfin Is Nothing And arr1(num1, 2) > 1 Then
            num2 = num2 + 1
            arr2(num1, num2) = Sheets("sheet1").[A2].Offset(num4)
        End If
    Next num4
Next num1
Sheets("sheet2").[C3].Resize(UBound(arr1), num3) = arr2
End Sub
 
Upvote 0
eke_rula đã viết:
Em sửa lại như vầy được không anh?
PHP: 
Sub loc()
Dim num1 As Long, num2 As Long, num3 As Long, num4 As Long, num5 As Long, rng As Range, sfin As Range, arr1, arr2
arr1 = Sheets("sheet2").Range("A3:B" & Sheets("sheet2").[A60000].End(xlUp).Row)
num3 = Sheets("sheet1").[A60000].End(xlUp).Row - 2
ReDim arr2(1 To UBound(arr1, 1), 1 To num3)
For num1 = 1 To num3
    num5 = WorksheetFunction.Max(num5, Sheets("sheet1").Cells(num1 + 2, Columns.Count).End(xlToLeft).Column)
Next num1
Set rng = Sheets("sheet1").[B2].Resize(1, num5 - 1)
For num1 = 1 To UBound(arr1)
    num2 = 0
    For num4 = 1 To num3
        Set sfin = rng.Offset(num4).Find(arr1(num1, 1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)
        If Not sfin Is Nothing And arr1(num1, 2) > 1 Then
            num2 = num2 + 1
            arr2(num1, num2) = Sheets("sheet1").[A2].Offset(num4)
        End If
    Next num4
Next num1
Sheets("sheet2").[C3].Resize(UBound(arr1), num3) = arr2
End Sub
Nhấp chuột vào đây để mở rộng...
Ổn rồi, Nếu được thì coi như sheet2 chưa có cột A và B, viết code cho cả cột A đến cột cuối
Dùng Num1, Num2 khó đọc code quá, dùng từ gợi nhớ để dể theo dõi code
 
Upvote 0
Cảm ơn anh/chị eke_rula về bài code rất hay ạ!
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn anh/chị eke_rula về bài code rất hay ạ!
 
Lần chỉnh sửa cuối:
Upvote 0
HieuCD đã viết:
Ổn rồi, Nếu được thì coi như sheet2 chưa có cột A và B, viết code cho cả cột A đến cột cuối
Dùng Num1, Num2 khó đọc code quá, dùng từ gợi nhớ để dể theo dõi code
Nhấp chuột vào đây để mở rộng...
Vậy thêm cái dictionarry nữa là được anh!!!
PHP: 
Sub loc()
Dim num1 As Long, num2 As Long, num3 As Long, num4 As Long, num5 As Long, rng As Range, sfin As Range, arr1, arr2, arr3
num3 = Sheets("sheet1").[A60000].End(xlUp).Row - 2
For num1 = 1 To num3
    num5 = WorksheetFunction.Max(num5, Sheets("sheet1").Cells(num1 + 2, Columns.Count).End(xlToLeft).Column)
Next num1
arr3 = Sheets("sheet1").[B3].Resize(num3, num5 - 1)
With CreateObject("scripting.dictionary")
    For num1 = 1 To UBound(arr3)
        For num4 = 1 To UBound(arr3, 2)
            If arr3(num1, num4) <> Empty Then
                If Not .exists(arr3(num1, num4)) Then
                    .Add arr3(num1, num4), 1
                Else
                    .Item(arr3(num1, num4)) = .Item(arr3(num1, num4)) + 1
                End If
            End If
        Next num4
    Next num1
    Sheets("sheet2").[A3].Resize(.Count, 1) = WorksheetFunction.Transpose(.keys)
    Sheets("sheet2").[B3].Resize(.Count, 1) = WorksheetFunction.Transpose(.items)
End With
arr1 = Sheets("sheet2").Range("A3:B" & Sheets("sheet2").[A60000].End(xlUp).Row)
ReDim arr2(1 To UBound(arr1, 1), 1 To num3)
Set rng = Sheets("sheet1").[B2].Resize(1, num5 - 1)
For num1 = 1 To UBound(arr1)
    num2 = 0
    For num4 = 1 To num3
        Set sfin = rng.Offset(num4).Find(arr1(num1, 1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)
        If Not sfin Is Nothing And arr1(num1, 2) > 1 Then
            num2 = num2 + 1
            arr2(num1, num2) = Sheets("sheet1").[A2].Offset(num4)
        End If
    Next num4
Next num1
Sheets("sheet2").[C3].Resize(UBound(arr1), num3) = arr2
End Sub
 
Upvote 0
eke_rula đã viết:
Vậy thêm cái dictionarry nữa là được anh!!!
PHP: 
Sub loc()
Dim num1 As Long, num2 As Long, num3 As Long, num4 As Long, num5 As Long, rng As Range, sfin As Range, arr1, arr2, arr3
num3 = Sheets("sheet1").[A60000].End(xlUp).Row - 2
For num1 = 1 To num3
    num5 = WorksheetFunction.Max(num5, Sheets("sheet1").Cells(num1 + 2, Columns.Count).End(xlToLeft).Column)
Next num1
arr3 = Sheets("sheet1").[B3].Resize(num3, num5 - 1)
With CreateObject("scripting.dictionary")
    For num1 = 1 To UBound(arr3)
        For num4 = 1 To UBound(arr3, 2)
            If arr3(num1, num4) <> Empty Then
                If Not .exists(arr3(num1, num4)) Then
                    .Add arr3(num1, num4), 1
                Else
                    .Item(arr3(num1, num4)) = .Item(arr3(num1, num4)) + 1
                End If
            End If
        Next num4
    Next num1
    Sheets("sheet2").[A3].Resize(.Count, 1) = WorksheetFunction.Transpose(.keys)
    Sheets("sheet2").[B3].Resize(.Count, 1) = WorksheetFunction.Transpose(.items)
End With
arr1 = Sheets("sheet2").Range("A3:B" & Sheets("sheet2").[A60000].End(xlUp).Row)
ReDim arr2(1 To UBound(arr1, 1), 1 To num3)
Set rng = Sheets("sheet1").[B2].Resize(1, num5 - 1)
For num1 = 1 To UBound(arr1)
    num2 = 0
    For num4 = 1 To num3
        Set sfin = rng.Offset(num4).Find(arr1(num1, 1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)
        If Not sfin Is Nothing And arr1(num1, 2) > 1 Then
            num2 = num2 + 1
            arr2(num1, num2) = Sheets("sheet1").[A2].Offset(num4)
        End If
    Next num4
Next num1
Sheets("sheet2").[C3].Resize(UBound(arr1), num3) = arr2
End Sub
Nhấp chuột vào đây để mở rộng...
Giai đoạn dầu viết code thế nầy là giỏi lắm rồi, giờ mới là phần khó:
Dùng Dic thì không cần dùng Find, xét điều kiện để lấy mảng kết quả trong vòng lập For của Dic dựa vào thiết lập Item, bỏ for thứ 2 của Find
Chúc bạn 1 tối vui
 
Upvote 0
HieuCD đã viết:
Giai đoạn dầu viết code thế nầy là giỏi lắm rồi, giờ mới là phần khó:
Dùng Dic thì không cần dùng Find, xét điều kiện để lấy mảng kết quả trong vòng lập For của Dic dựa vào thiết lập Item, bỏ for thứ 2 của Find
Chúc bạn 1 tối vui
Nhấp chuột vào đây để mở rộng...
Em thử thêm lần nữa :
PHP: 
Sub loc2()
Dim num1 As Long, num2 As Long, num3 As Long, num4 As Long, num5 As Long, rng As Range, sfin As Range, arr1, arr2, arr3
num3 = Sheets("sheet1").[A60000].End(xlUp).Row - 2
For num1 = 1 To num3
    num5 = WorksheetFunction.Max(num5, Sheets("sheet1").Cells(num1 + 2, Columns.Count).End(xlToLeft).Column)
Next num1
arr3 = Sheets("sheet1").[A3].Resize(num3, num5)
ReDim arr2(1 To 100, 1 To num3 + 2)
With CreateObject("scripting.dictionary")
    For num1 = 1 To UBound(arr3)
        For num4 = 2 To UBound(arr3, 2)
            If arr3(num1, num4) <> Empty Then
                If Not .exists(arr3(num1, num4)) Then
                    num2 = num2 + 1
                    .Add arr3(num1, num4), num2
                    arr2(num2, 1) = arr3(num1, num4): arr2(num2, 2) = 1: arr2(num2, 3) = arr3(num1, 1)
                Else
                    arr2(.Item(arr3(num1, num4)), 2) = arr2(.Item(arr3(num1, num4)), 2) + 1
                    For num5 = 4 To UBound(arr2, 2)
                        If arr2(.Item(arr3(num1, num4)), num5) = Empty Then
                            arr2(.Item(arr3(num1, num4)), num5) = arr3(num1, 1)
                            Exit For
                        End If
                    Next num5
                End If
            End If
        Next num4
    Next num1
End With
Sheets("sheet2").[A3].Resize(UBound(arr2), UBound(arr2, 2)) = arr2
End Sub
 
Upvote 0
eke_rula đã viết:
Em thử thêm lần nữa :
PHP: 
Sub loc2()
Dim num1 As Long, num2 As Long, num3 As Long, num4 As Long, num5 As Long, rng As Range, sfin As Range, arr1, arr2, arr3
num3 = Sheets("sheet1").[A60000].End(xlUp).Row - 2
For num1 = 1 To num3
    num5 = WorksheetFunction.Max(num5, Sheets("sheet1").Cells(num1 + 2, Columns.Count).End(xlToLeft).Column)
Next num1
arr3 = Sheets("sheet1").[A3].Resize(num3, num5)
ReDim arr2(1 To 100, 1 To num3 + 2)
With CreateObject("scripting.dictionary")
    For num1 = 1 To UBound(arr3)
        For num4 = 2 To UBound(arr3, 2)
            If arr3(num1, num4) <> Empty Then
                If Not .exists(arr3(num1, num4)) Then
                    num2 = num2 + 1
                    .Add arr3(num1, num4), num2
                    arr2(num2, 1) = arr3(num1, num4): arr2(num2, 2) = 1: arr2(num2, 3) = arr3(num1, 1)
                Else
                    arr2(.Item(arr3(num1, num4)), 2) = arr2(.Item(arr3(num1, num4)), 2) + 1
                    For num5 = 4 To UBound(arr2, 2)
                        If arr2(.Item(arr3(num1, num4)), num5) = Empty Then
                            arr2(.Item(arr3(num1, num4)), num5) = arr3(num1, 1)
                            Exit For
                        End If
                    Next num5
                End If
            End If
        Next num4
    Next num1
End With
Sheets("sheet2").[A3].Resize(UBound(arr2), UBound(arr2, 2)) = arr2
End Sub
Nhấp chuột vào đây để mở rộng...
Đúng là không gì làm khó được bạn
Bạn lưu ý thêm:
- Chỉ ghi tên khách hàng khi có 2 khách hàng trở lên
- Num5 có thể tính trực tiếp từ arr2(.Item(arr3(num1, num4)), 2)
 
Upvote 0
HieuCD đã viết:
Đúng là không gì làm khó được bạn
Bạn lưu ý thêm:
- Chỉ ghi tên khách hàng khi có 2 khách hàng trở lên
- Num5 có thể tính trực tiếp từ arr2(.Item(arr3(num1, num4)), 2)
Nhấp chuột vào đây để mở rộng...
Ý hay đấy anh ạ, num5 thay trực tiếp bằng arr2(,2), em không để ý chỗ này, cám ơn anh!!
Em quên mất cái điều kiện >1, vì đã đi theo hướng này chắc phải chạy thêm vòng lặp duyệt qua arr2(,2) lần nữa .
 
Upvote 0
eke_rula đã viết:
Ý hay đấy anh ạ, num5 thay trực tiếp bằng arr2(,2), em không để ý chỗ này, cám ơn anh!!
Em quên mất cái điều kiện >1, vì đã đi theo hướng này chắc phải chạy thêm vòng lặp duyệt qua arr2(,2) lần nữa .
Nhấp chuột vào đây để mở rộng...
Bạn còn Arr1 chưa dùng, lưu tạm khách hàng đầu tiên
 
Upvote 0
Đã dùng dic thì key là tên mặt hàng, item là mảng khách hàng. Nếu muốn tập dùng Dic thì đây là dịp tốt để thử sức.

Tuy nhiên, tôi nghĩ bài này dùng mảng 2 chiều sort theo tên mặt hàng và khách hàng hay hơn.
mảng trải dài:
(1) Văn coca
(1) Văn dép
(1) Văn thuốc
(2) Tuấn giày
(2) Tuán pepsi
... (cái số là số thứ tự của KH, để dễ tìm sau này)
mảng sorted:
(1) Văn coca
(1) Văn dép
(3) Thái dép
(2) Tuấn giày
(3) Thái giày
...
Có mảng này rồi thì chỉ việc đọc và chép ra
 
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

T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết
Trả lời
0
Đọc
23
TramAnhNguyen692
T
S
NHỜ ANH EM GIÚP MÌNH TÌM KIẾM DỮ LIỆU
Trả lời
11
Đọc
111
Duy Tùng 9x
Duy Tùng 9x
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng,
Trả lời
8
Đọc
42
thuytrangbp28
T
V
Help: Hàm đếm lọc giá trị trùng (3 người xem)
Trả lời
11
Đọc
52
Duy Tùng 9x
Duy Tùng 9x
B
XIN HƯỚNG DẪN CÁCH ĐỂ HÀM XLOOKUP TỰ NHẢY THEO SỐ LƯỢNG DÒNG CỦA ĐIỀU KIỆN KHÔNG SỬ DỤNG VBA
Trả lời
2
Đọc
29
Duy Tùng 9x
Duy Tùng 9x
C
Filter có điều kiện đang ở dạng Cột (1 người xem)
Trả lời
2
Đọc
43
thuytrangbp28
T
L
Có ai biết fix lỗi này không ạ
    • Buồn
Trả lời
2
Đọc
35
lekimhuy0812
L
tonny jj
Lập hàm thể hiện số công lệnh của ngày đi công tác
Trả lời
5
Đọc
167
Gà Công Nghệ
Gà Công Nghệ
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365 (1 người xem)
    • Thích
Trả lời
1
Đọc
3K
PhanTuHuong
PhanTuHuong
K
Lỗi cấu trúc hình ảnh khi mở file bằng điện thoại (1 người xem)
Trả lời
0
Đọc
30
Kecodonlalala
K
N
  • Question Question
Nhờ mọi người góp ý cho file Quản lý bán hàng viết bằng VBA đầu tay của mình
    • Cảm ơn
    • Thích
Trả lời
7
Đọc
152
newbiexo
N
H
Xin được trợ giúp lỗi máy không mở được cửa sổ VBE.
Trả lời
3
Đọc
64
Nguyễn Duy Tuân
Nguyễn Duy Tuân
HeSanbi
  • Question Question
Sự khác nhau giữa book.Worksheets và book.Sheets trong Application (1 người xem)
    • Thích
Trả lời
2
Đọc
141
Nguyễn Duy Tuân
Nguyễn Duy Tuân
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
7
Đọc
328
PhanTuHuong
PhanTuHuong
yeudoi
Cà phê giao lưu cùng thành viên kỳ cựu Cao Mạnh Sơn 19h 23/2/2025
    • Thích
    • Yêu thích
Trả lời
1
Đọc
69
PhanTuHuong
PhanTuHuong
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
8
Đọc
189
thuytrangbp28
T
K
Làm sao để ô excel hiển thị tên nhưng khi nhấp vào thì đó là công thức
Trả lời
1
Đọc
47
pycckuu410
P
Nguyễn Duy Tuân
Phiên bản mới Add-in A-Tools v10 (2024)
    • Thích
2 3
Trả lời
41
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
326
Đọc
25K
pycckuu410
P
V
  • Question Question
Đếm xếp loại của đơn hàng
Trả lời
8
Đọc
233
vanlinh_2904
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
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom