Tạo Dropbox cho danh sách khách hàng

[tuanping72]

Chào các Pro,
Các bạn thể chỉ giúp em làm file excel như sau :
Mình có 1 list danh sách khách hàng phân loại theo ngành nghề, khu công nghiệp, tỉnh/thành phố…. Như trong list đính kèm.
Mình muốn tạo 3 dropbox ( 1 theo ngành nghề, 1 theo khu công nghiệp, 1 theo tỉnh/thành phố) gần như trong Auto Filter nhưng trong dropbox chỉ cần chọn vào mã khách hàng sau đó nhấn ok là tất cả những khách hàng lựa chọn hiển thị.( Vì sếp mình yêu cầu làm Dropbox như thế cho giống form bên công ty mẹ.)
Thí dụ: trong Dropbox theo ngành nghề gồm ( All, mechanical, electronics, automotive,), khi chọn All và nhấn OK là tất cả những KH hiển thị. Còn khi chọn mechanical thì chỉ những KH mechanical hiện ra.

Nếu có thể các bạn hướng dẫn mình làm Dropbox theo ngành nghề, còn 2 Dropbox khác mình sẽ dựa theo đó làm

 

[SA_DQ]

Bạn xem tronmg file kèm theo

Thử chọn vài mục tại [F2]

 

[tuanping72]

Cám ơn bạn, nhưng không giống với ý của mình vì khi mình chọn vào mechanical trong dropbox cua industrial type thi những công ty thuộc mechanical lại không hiện ra.
Trong Dropbox của industrial type mình muốn bao gồm các mục ( All, mechanical, electrical, automobile, còn những ngành nghề khác mình dặt tên là Others).
Có thể là phải viết code nhưng mình không biết. Nếu các bạn biết thì chỉ cho mình các bước chi tiết để làm nhe.
chân thành cám ơn.
Sdt liên lạc của mình : 0904259271 Tuấn

 

[SA_DQ]

Bạn xem file Excel 2003 vậy

Hình như file trên bị xơi macro rồi thì fải

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [f2]) Is Nothing Then
    Dim Sh As Worksheet, Cls As Range
    Dim Rws As Long
    
    Set Sh = ThisWorkbook.Worksheets("S1")
    Rws = Sh.[B1].CurrentRegion.Rows.Count
    [b4].CurrentRegion.Offset(1).Resize(Rws).Clear
    Sh.Columns("A:G").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sh.[AJ1:AJ2], CopyToRange:=Sh.[AE4:AK4], Unique:=False
    If [f2].Value <> "OTHERS" Then
        Sh.[aE4].CurrentRegion.Offset(1).Copy Destination:=[A5]
    Else
        Const Nghe As String = "MECHANICAL ELECTRICAL AUTOMOBILE"
        For Each Cls In Sh.Range(Sh.[aj5], Sh.[Aj65500].End(xlUp))
            If InStr(1, Nghe, Cls.Value) < 1 Then
                Rws = Cls.Row
                With [a65500].End(xlUp).Offset(1)
                    .Resize(, 8).Value = Sh.Cells(Rws, "Ae").Resize(, 8).Value
                End With
            End If
        Next Cls
    End If
 End If
End Sub

 

[tuanping72]

Giải thích câu lệnh cho đoạn Code trên

rất cám ơn bạn, nhưng bạn có thể giải thích chi tiết từng câu lệnh trong doạn code trên giúp mình không?

 

[SA_DQ]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) ': Đây là macro sự kiện'
 If Not Intersect(Target, [f2]) Is Nothing Then ': Nếu ta thay trị trong [F2], thì macro tác động'
 ' Hai dòng này khai báo các biến cần dùng:'
    Dim Sh As Worksheet, Cls As Range
    Dim Rws As Long
' Gán trang tính "S1" vô biến đối tượng đã khai báo:'    
    Set Sh = ThisWorkbook.Worksheets("S1")
' Lấy số dòng đã sử dụng của trang này đem gán vô biến đã khai báo:'
    Rws = Sh.[B1].CurrentRegion.Rows.Count
' Xoá dữ liệu cũ của lần chạy trước đó của macro:'
    [b4].CurrentRegion.Offset(1).Resize(Rws).Clear
' Áp dụng fương thức lọc mở rọng với vùng trước cột "H" của trang Sh:'
    Sh.Columns("A:G").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sh.[AJ1:AJ2], CopyToRange:=Sh.[AE4:AK4], Unique:=False
' Nếu trị trong [F2] # "OTHERS" thì thực thi lệnh sau:'
    If [f2].Value <> "OTHERS" Then
'Copy vùng kết quả của fương thức lọc bên trên đến vùng cần hiễn thị kết quả:'
        Sh.[aE4].CurrentRegion.Offset(1).Copy Destination:=[A5]
' Nếu Không thoả điều kiện thì thực thi các lệnh sau:'
    Else
' Khai báo 1 hằng số để tiện xài:'
        Const Nghe As String = "MECHANICAL ELECTRICAL AUTOMOBILE"
'Tạo vòng lặp duyệt toàn bộ cột [AJ] thuộc vùng kết quả lọc mở rọng bên trên:'
        For Each Cls In Sh.Range(Sh.[aj5], Sh.[Aj65500].End(xlUp))
'Nếu trị trong ô khảo sát không chứa các từ trong hằng khai báo, thì:'
            If InStr(1, Nghe, Cls.Value) < 1 Then
'Lấy dòng đang khảo sát (duyệt) đưa vô biến khai báo:'
                Rws = Cls.Row
' Báo cho VBA biết ta sẽ làm việc với ô trống đầu tiên thuộc cột [A] của trang tính hiện hành:'
                With [a65500].End(xlUp).Offset(1)
' 8 ô trong hàng (dòng) sẽ nhận trị từ 8 ô của vùng khảo sát bên Sh:'
                    .Resize(, 8).Value = Sh.Cells(Rws, "Ae").Resize(, 8).Value
' Báo hết làm việc với vùng đã chọn:'
                End With
' Kết thúc điều kiện xét:'
            End If
' Chuyển sang xét ô kết tiếp:'
        Next Cls
' Như trên:'
    End If
' Như trên:'
 End If
End Sub