Lọc mảng nhiều điều kiện

Liên hệ QC
phihndhsp đã viết:
Đúng là có người bàn và vấn đề đã ra, không cần tạo name, đúng là 1 nhóm người cùng suy nghĩ có khác
sửa lại code bài 35 một tí, dùng dic lấy duy nhất sau đó đưa vào trong validation
Mã: 
Public Sub LIST()
Dim Dic As Object, Arr(), I As Long, TEM As String, K As Long
Dim rng As Range
    Application.ScreenUpdating = False
    Set Dic = CreateObject("Scripting.Dictionary")
    DONGCUOI = Sheet1.Range("D65000").End(xlUp).Row
    Set rng = Sheet1.Range("D2:D" & DONGCUOI)
    ReDim Arr(1 To DONGCUOI)
    For I = 1 To DONGCUOI - 1
               TEM = rng(I, 1)
            If Not Dic.Exists(TEM) Then
                K = K + 1
                Dic.Add TEM, K
                Arr(K) = rng(I, 1).Value
            End If
    Next I
    TEM = Join(Arr, ",")
    For I = K To DONGCUOI
        TEM = Replace(TEM, ",,", ",")
    Next
    TEM = Left(TEM, Len(TEM) - 1)
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=TEM
    End With
        Application.ScreenUpdating = true
End Sub
Nhấp chuột vào đây để mở rộng...
Nếu chỉ Add mỗi cái Validation thì xài code sau đi cho nó gọn
PHP: 
Public Sub DicAdd_Validation()
    Dim dl(), i As Long, Dic As Object
    dl = Range([D2], [D65536].End(3)).Value
    Set Dic = CreateObject("scripting.dictionary")
       For i = 1 To UBound(dl)
            Dic(dl(i, 1)) = ""
       Next
       Range("G2").Validation.Delete
       Range("G2").Validation.Add 3, , , Join(Dic.keys, ",")
    Set Dic = Nothing
End Sub
 
phihndhsp đã viết:
Vì chưa xác định chiều dài của mảng một chiều nên tôi lấy chiều dài dài nhất, và khi dùng hàm join nó sẽ thêm nhiều dấu ,,, nên cần xử lý những chuỗi ,, lại
Nhấp chuột vào đây để mở rộng...
nhìn phần chữ kí của anh chắc là anh ít xài Dic nên mới nghĩ và làm thế . còn anh nhìn chữ kí của em chắc cũng biết em thích tắm cái giếng nào . hihi . đâu cần phải khỗ vậy . nhờ anh và các bạn ở trên giúp đỡ , em mới nghĩ ra được cách này . cám ơn các bạn

Mã: 
Public Sub hello()
Dim Dic As Object, Arr As Variant, lr As Long, r As Long
    Application.ScreenUpdating = False
    Set Dic = CreateObject("Scripting.Dictionary")
    lr = WorksheetFunction.Max(Sheet1.Range("D65000").End(xlUp).Row, 2)
    Arr = Sheet1.Range("D2:D" & lr).Value
    If IsArray(Arr) Then
        For r = 1 To lr - 1
            If WorksheetFunction.Trim(Arr(r, 1)) <> "" Then Dic(Arr(r, 1)) = 1
        Next
    Else
        If WorksheetFunction.Trim(Arr) <> "" Then Dic(Arr) = 1
    End If
    Sheet1.Range("G2").ClearContents
    With Sheet1.Range("G2").Validation
        .Delete
        If Dic.Count > 0 Then
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=Join(Dic.keys(), ",")
        End If
    End With
    Application.ScreenUpdating = True
End Sub
 
Thêm 1 cách không xài DIC nè:
Mã: 
Sub List_HICHICHIC()
Application.ScreenUpdating = False
Dim Lr As Long, Str As String, I As Long
  With Sheet1
    Lr = .Range("D" & Rows.Count).End(xlUp).Row
    For I = 2 To Lr
       If .Application.WorksheetFunction.CountIf(.Range("D2:D" & I), .Range("D" & I)) = 1 Then
             Str = Str & "," & .Range("D" & I)
        End If
    Next
    With .[G2].Validation
        .Delete
        .Add 3, , ,Str
    End With
 End With
Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
doveandrose đã viết:
nhìn phần chữ kí của anh chắc là anh ít xài Dic nên mới nghĩ và làm thế . còn anh nhìn chữ kí của em chắc cũng biết em thích tắm cái giếng nào . hihi . đâu cần phải khỗ vậy . nhờ anh và các bạn ở trên giúp đỡ , em mới nghĩ ra được cách này . cám ơn các bạn

Mã: 
Public Sub hello()
Dim Dic As Object, Arr As Variant, lr As Long, r As Long
    Application.ScreenUpdating = False
    Set Dic = CreateObject("Scripting.Dictionary")
    lr = WorksheetFunction.Max(Sheet1.Range("D65000").End(xlUp).Row, 2)
    Arr = Sheet1.Range("D2:D" & lr).Value
    If IsArray(Arr) Then
        For r = 1 To lr - 1
            If WorksheetFunction.Trim(Arr(r, 1)) <> "" Then Dic(Arr(r, 1)) = 1
        Next
    Else
        If WorksheetFunction.Trim(Arr) <> "" Then Dic(Arr) = 1
    End If
    Sheet1.Range("G2").ClearContents
    With Sheet1.Range("G2").Validation
        .Delete
        If Dic.Count > 0 Then
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=Join(Dic.keys(), ",")
        End If
    End With
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Tám một tẹo
hình như Bạn cũng mê Dic giống mình thì phải .....có thì cứ lôi ra mà xài đi cho sướng vậy cất dấu để rành mằn chi ....khổ quá đi mất..--=0--=0
 
kieu manh đã viết:
Tám một tẹo
hình như Bạn cũng mê Dic giống mình thì phải .....có thì cứ lôi ra mà xài đi cho sướng vậy cất dấu để rành mằn chi ....khổ quá đi mất..--=0--=0
Nhấp chuột vào đây để mở rộng...

cái đó đương nhiên rồi . em đoán là chức năng remove Duplicate của excel cũng hoạt động theo nguyên tắc này .
khi các bạn từng thử nghiệm lấy danh sách duy nhất với cỡ khoảng hàng trăm nghìn mã số khác nhau thì có lẽ các bạn sẽ dẹp bỏ được ý nghĩ : lấy danh sách không trùng mà không cần dùng Dic hoặc chức năng remove duplicate
còn anh nữa : bài viết của anh có 4 chữ số rồi sao vẫn các ngôi sao quay đều vậy ? phải bao nhiêu bài viết mới được 1 sao đứng im vậy ?
 
doveandrose đã viết:
cái đó đương nhiên rồi . em đoán là chức năng remove Duplicate của excel cũng hoạt động theo nguyên tắc này .
khi các bạn từng thử nghiệm lấy danh sách duy nhất với cỡ khoảng hàng trăm nghìn mã số khác nhau thì có lẽ các bạn sẽ dẹp bỏ được ý nghĩ : lấy danh sách không trùng mà không cần dùng Dic hoặc chức năng remove duplicate
còn anh nữa : bài viết của anh có 4 chữ số rồi sao vẫn các ngôi sao quay đều vậy ? phải bao nhiêu bài viết mới được 1 sao đứng im vậy ?
Nhấp chuột vào đây để mở rộng...
Bạn vào link sau mà tìm hiểu sao nha
[url]http://www.giaiphapexcel.com/forum/showthread.php?65521-%C4%90%E1%BB%91-v%E1%BB%81-%C3%BD-ngh%C4%A9a-c%C3%A1c-sao-v%C3%A0-c%C3%A1c-Title-c%E1%BB%A7a-GPE-qua-th%C6%A1[/URL]
 
Từ chiều về đề tài này thấy sum tụ nhất, học được cái mới, tuy không cần nó mình vẫn làm được việc, nhưng cảm thấy rất vui, kiến thức mà chia sẽ thì sẽ thu vô được rất rất nhiều cái mới
 
phihndhsp đã viết:
Vì chưa xác định chiều dài của mảng một chiều nên tôi lấy chiều dài dài nhất, và khi dùng hàm join nó sẽ thêm nhiều dấu ,,, nên cần xử lý những chuỗi ,, lại
Nhấp chuột vào đây để mở rộng...

cái này lúc trước nạp list cho validation cũng bị, được sự phụ NDU chỉ cho dùng
redim preverse, mảng một chiều mà, cứ dài tới đâu thì nối nó đến đó............hihihiih
 
Let'GâuGâu đã viết:
cái này lúc trước nạp list cho validation cũng bị, được sự phụ NDU chỉ cho dùng
redim preverse, mảng một chiều mà, cứ dài tới đâu thì nối nó đến đó............hihihiih
Nhấp chuột vào đây để mở rộng...
Uhm ha, sao mình lại không nhớ ra cái dụ preverse này ta(-.-)
 
Công nhân đề tài này xôm tụ thiệt.

Vẫn vụ tạo data validation
Nhưng bây giờ làm cho cell B1, (file của chủ topic), làm sao để đưa vào format dd/mm/yyyy trong code luôn.
Lấy cột A2 trở đi làm dữ liệu nguồn. Và khi code thì format như nào để được dạng Source: 23/06/2015,26/06/2015,29/06/2015

Thử code mà toàn nó đưa vào list là Value của dạng ngày .......hixxhixx
 
hpkhuong đã viết:
Công nhân đề tài này xôm tụ thiệt.

Vẫn vụ tạo data validation
Nhưng bây giờ làm cho cell B1, (file của chủ topic), làm sao để đưa vào format dd/mm/yyyy trong code luôn.
Lấy cột A2 trở đi làm dữ liệu nguồn. Và khi code thì format như nào để được dạng Source: 23/06/2015,26/06/2015,29/06/2015

Thử code mà toàn nó đưa vào list là Value của dạng ngày .......hixxhixx
Nhấp chuột vào đây để mở rộng...
Ý BẠN LÀ đưa ngày vào Validation phải ko nếu vậy thì code sau
mình mới đổi lại kiểu With CreateObject("scripting.dictionary")
PHP: 
Public Sub Dic_Validation()
Dim Arr(), i As Long
Arr = Range("A2", [A65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(Arr)
        .Item(Arr(i, 1)) = ""
        '.Item(Arr(i, 1)) = .Count
    Next
    Range("G2").Validation.Delete
    Range("G2").Validation.Add 3, , , Join(.keys, ",")
End With
End Sub
Bạn có thể tham khảo thêm ở link sau
http://www.giaiphapexcel.com/forum/...ng-Data-Validation-settings-list-Source/page3

http://www.giaiphapexcel.com/forum/showthread.php?84205-Hỏi-về-Data-Validation/page3
 
Lần chỉnh sửa cuối:
kieu manh đã viết:
Ý BẠN LÀ đưa ngày vào Validation phải ko nếu vậy thì code sau
mình mới đổi lại kiểu With CreateObject("scripting.dictionary")
PHP: 
Public Sub Dic_Validation()
    Dim dl(), i As Long
    dl = Range([A2], [A65536].End(3)).Value
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(dl)
            If dl(i, 1) <> "" Then
                If Not .Exists(dl(i, 1)) Then .Add dl(i, 1), ""
            End If
        Next 
       [G2].Validation.Delete
       [G2].Validation.Add 3, , , Join(.keys, ",")
    End With
End Sub
Bạn có thể tham khảo thêm ở link sau
http://www.giaiphapexcel.com/forum/...ng-Data-Validation-settings-list-Source/page3

http://www.giaiphapexcel.com/forum/showthread.php?84205-Hỏi-về-Data-Validation/page3
Nhấp chuột vào đây để mở rộng...
Cách mọi người đang làm hình như sẽ thỉnh thoảng bị lỗi khi đóng file rồi mở file lên.
Trước đây mình từng bị nên sau này không dùng Validation nữa.
Dùng cách khác cũng cho ra kết quả tương tự nhưng code có thể ngắn hơn nhiều. Cứ thử nghiên cứu thêm cách khác nha.
Chứ xem đoạn code ngắn tí tẹo của mình thì mất hứng suy nghĩ.
 
Tặng cho thớt này một kiểu nữa nè tha hồ mà lựa....Tui nhớ trước đây có thành viên dị ứng với Dic To Dic Thon keo tui ko biết Dic giờ tui viết các kiểu cho mà coi.. nha--=0--=0--=0
PHP: 
Public Sub Date_Validation()
    Dim dl(), i As Long
    dl = Range([A2], [A65536].End(3)).Value
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(dl)
            If Not .Exists(dl(i, 1)) Then .Item(dl(i, 1)) = .Count
        Next
        [G2].Validation.Delete
        [G2].Validation.Add 3, , , Join(.keys, ",")
    End With
End Sub
 
kieu manh đã viết:
Tặng cho thớt này một kiểu nữa nè tha hồ mà lựa....Tui nhớ trước đây có thành viên dị ứng với Dic To Dic Thon keo tui ko biết Dic giờ tui viết các kiểu cho mà coi.. nha--=0--=0--=0
PHP: 
Public Sub Date_Validation()
    Dim dl(), i As Long
    dl = Range([A2], [A65536].End(3)).Value
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(dl)
            If Not .Exists(dl(i, 1)) Then .Item(dl(i, 1)) = .Count
        Next
        [G2].Validation.Delete
        [G2].Validation.Add 3, , , Join(.keys, ",")
    End With
End Sub
Nhấp chuột vào đây để mở rộng...

Thử sửa dòng này

If Not .Exists(dl(i, 1)) Then .Item(dl(i, 1)) = .Count

Thành dòng này xem coi có chết ai không. Viết chi dài lê thê vậy?

.Item(dl(i, 1)) = ""
 
quanghai1969 đã viết:
Cách mọi người đang làm hình như sẽ thỉnh thoảng bị lỗi khi đóng file rồi mở file lên.
Trước đây mình từng bị nên sau này không dùng Validation nữa.
Dùng cách khác cũng cho ra kết quả tương tự nhưng code có thể ngắn hơn nhiều. Cứ thử nghiên cứu thêm cách khác nha.
Chứ xem đoạn code ngắn tí tẹo của mình thì mất hứng suy nghĩ.
Nhấp chuột vào đây để mở rộng...
Em thấy chạy tốt mà có lỗi gì đâu
 
quanghai1969 đã viết:
Cách mọi người đang làm hình như sẽ thỉnh thoảng bị lỗi khi đóng file rồi mở file lên.
Trước đây mình từng bị nên sau này không dùng Validation nữa.
Dùng cách khác cũng cho ra kết quả tương tự nhưng code có thể ngắn hơn nhiều. Cứ thử nghiên cứu thêm cách khác nha.
Chứ xem đoạn code ngắn tí tẹo của mình thì mất hứng suy nghĩ.
Nhấp chuột vào đây để mở rộng...
cái này em nhớ có bị vài lần "Data may have been lost" thì phải . nhưng hình như chỉ có file .xls mới bị . các file sau 2003 không bị nữa
nhưng nếu không phải validata thì ở dạng gì khác nữa vậy anh ?
 
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
  • Question
Xin giúp chọn nhiểu phần tử của drop list cùng 1 lúc
Trả lời
0
Đọc
12
tle2003
T
D
Định dạng trong excel làm nghiệm thu đường
2
Trả lời
29
Đọc
13K
HieuCD
H
V
  • Question
GIúp code xóa các tên mặt hàng trùng nhau, chỉ chừa lại tên cho dòng trên cùng
Trả lời
4
Đọc
109
cantl
C
L
Tạo hàm Round cho nhiều dòng
Trả lời
10
Đọc
6K
cantl
C
dunghtgiga
Không cho người khác chỉnh sửa nội dung bảng tính
Trả lời
5
Đọc
185
cantl
C
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom