Lọc mảng nhiều điều kiện (1 người xem)

huypham · 16/7/15

Nhờ các cụ giúp mình bài toán này:
Mình có bảng dữ liệu sau:

Giờ mình muốn tạo 1 sheet khác, lọc riêng Mã hàng, Tên hàng, Số lượng theo điều kiện của Ngày và NCC, ví dụ như:

Khi thay đổi điều kiện ở ô B1 và B2 thì sẽ các giá trị từ dòng 4 sẽ cập nhật theo.
Các cụ có phương án nào hay tư vấn giúp em.
Đa tạ!

khuongvietphong · 17/7/15

huypham đã viết:
Nhờ các cụ giúp mình bài toán này:
Mình có bảng dữ liệu sau:
View attachment 143994

Giờ mình muốn tạo 1 sheet khác, lọc riêng Mã hàng, Tên hàng, Số lượng theo điều kiện của Ngày và NCC, ví dụ như:
View attachment 143995
Khi thay đổi điều kiện ở ô B1 và B2 thì sẽ các giá trị từ dòng 4 sẽ cập nhật theo.
Các cụ có phương án nào hay tư vấn giúp em.
Đa tạ!

Bạn copy CT này vào ô D4 sau đó kéo sang, xuống cho các ô còn lại nhé:

=IFERROR(OFFSET('TONG HOP'!$A$1,SMALL(IF('TONG HOP'!$A$2:$A$9='CHI TIET'!$B$1,IF('TONG HOP'!$D$2:$D$9='CHI TIET'!$B$2,MATCH('TONG HOP'!$B$2:$B$9,'TONG HOP'!$B$2:$B$9,0),"")),ROW(1:1)),MATCH(A$3,'TONG HOP'!$A$1:$E$1,0)-1),"")

Bạn kết thúc bằng CTRL+SHIFT+ENTER

giangleloi · 17/7/15

hpkhuong đã viết:
Còn code thì thử cái này:

[GPECODE=vb]
Sub Loc()
Dim Sh As Worksheet, Arr(), zArr()
Dim Rws As Long, J&, W&, dk1 As Date, dk2 As String
dk1 = Sheets("CHI TIET").[B1].Value
dk2 = Sheets("CHI TIET").[B2].Value
zArr = Array(2, 3, 5)
Set Sh = Sheets("TONG HOP")
With Sh.[A2]
Rws = .CurrentRegion.Rows.Count
Arr() = .Resize(Rws, 5).Value
End With
ReDim dArr(1 To Rws, 1 To 3)
For J = 1 To UBound(Arr())
If Arr(J, 1) = dk1 And Arr(J, 4) = dk2 Then
W = 1 + W
For Z = 0 To UBound(zArr)
dArr(W, Z + 1) = Arr(J, zArr(Z))
Next Z
End If
Next J
If W Then
Sheets("CHI TIET").[A4].Resize(65000, 3).ClearContents
Sheets("CHI TIET").[A4].Resize(W, 3).Value = dArr()
End If
End Sub
[/GPECODE]

Code trên chưa có ổn. Lẽ ra thì khi để trống không chọn ngày đặt hàng, chọn mỗi NCC thì ở bên dưới phải sổ tất cả dữ liệu mà mình đặt hàng của NCC đó.

giangleloi · 17/7/15

hpkhuong đã viết:
Thử làm theo hướng bác bảo
+ Nếu cả 2 điều kiện không trống thì dò theo 2 điều kiện
+ Nếu một trong 2 trống,thì chỉ dò theo cái điều kiện Không trống

Mà cứ lẫn quẫn trong vùng If, Elseif,..........If hoài. Được cái này thì cái kia không chạy, hoặc ngược lại.Hix hixx......

Bác code mẫu đoạn này cho tôi học hỏi với, lẫn quẫn quá.

Xem thử file này coi sao:

doveandrose · 17/7/15

toàn sát thủ không . ngưỡng mộ ghê

doveandrose · 17/7/15

mình chậm chạm nên chỉ kịp ghi có 1 dòng . huhu

Mã:

If (Arr(I, 1) = dk1 Or dk1 = Empty) And (Arr(I, 4) = dk2 Or dk2 = Empty) Then

huypham · 17/7/15

Hic, cảm ơn các cụ, toàn cao thủ cả __--__

E được voi đòi Hai Bà Trưng thêm cái nữa:
Trong phần Data Validation của ô NCC em muốn lọc ra danh sách các NCC trong sheet TONG HOP có được không?

giangleloi · 17/7/15

huypham đã viết:
Hic, cảm ơn các cụ, toàn cao thủ cả
E được voi đòi Hai Bà Trưng thêm cái nữa:
Trong phần Data Validation của ô NCC em muốn lọc ra danh sách các NCC trong sheet TONG HOP có được không?

Đương nhiên là được, tại menu data chọn Remove Duplicates sẽ được 1 danh sách duy nhất, bấm Ctrl + F3 đặt name cho danh sách đó rồi quăng cái tên Name đã đặt đó vào list của Data Validation.

huypham · 17/7/15

giangleloi đã viết:
Đương nhiên là được, tại menu data chọn Remove Duplicates sẽ được 1 danh sách duy nhất, bấm Ctrl + F3 đặt name cho danh sách đó rồi quăng cái tên Name đã đặt đó vào list của Data Validation.

Nhưng mỗi lần thêm tên NCC mới ở sheet tổng hợp thì phải làm Remove Duplicates từ đầu. Có cách nào lọc tự động được không?

giangleloi · 17/7/15

huypham đã viết:
Nhưng mỗi lần thêm tên NCC mới ở sheet tổng hợp thì phải làm Remove Duplicates từ đầu. Có cách nào lọc tự động được không?

À. Thế thì lọc rồi thêm vào bằng code luôn. hihi. Bạn muốn gì cứ gửi file lên các thành viên sẽ giúp nhiệt tình mà.

huypham · 17/7/15

giangleloi đã viết:
À. Thế thì lọc rồi thêm vào bằng code luôn. hihi. Bạn muốn gì cứ gửi file lên các thành viên sẽ giúp nhiệt tình mà.

giangleloi đã viết:
Xem thử file này coi sao:

giangleloi đã viết:
Tập tin đính kèm

Dat hang.7z (62.0 KB, 0 lần tải)

Là file của bạn luôn ấy.

giangleloi · 17/7/15

huypham đã viết:
Là file của bạn luôn ấy.

File thực tế của bạn có được bố trí dữ liệu theo như file bài 1 bạn đưa lên không??? Nếu giống thì mới dám làm (Làm rùi mà bỏ thì phí).

Let'GâuGâu · 17/7/15

huypham đã viết:
Là file của bạn luôn ấy.

pivot thì ko có tốn nhiều công sức nên có thể bỏ...........hihihihi

huypham · 17/7/15

giangleloi đã viết:
File thực tế của bạn có được bố trí dữ liệu theo như file bài 1 bạn đưa lên không??? Nếu giống thì mới dám làm (Làm rùi mà bỏ thì phí).

File thực tế mình cũng bố trí như vậy, không thì phí công các bác. Nếu có thay đổi thì lại cố ngồi mò edit code sau, gà VB mà +-+-+-+

phihndhsp · 18/7/15

huypham đã viết:
Nhờ các cụ giúp mình bài toán này:
Mình có bảng dữ liệu sau:

Giờ mình muốn tạo 1 sheet khác, lọc riêng Mã hàng, Tên hàng, Số lượng theo điều kiện của Ngày và NCC, ví dụ như:
Khi thay đổi điều kiện ở ô B1 và B2 thì sẽ các giá trị từ dòng 4 sẽ cập nhật theo.
Các cụ có phương án nào hay tư vấn giúp em.
Đa tạ!

Xem file này xem có áp dụng gì được không?

ChanhTQ@ · 18/7/15

Thêm 1 hàm mảng tự tạo cho bạn tùy nghi lựa các tiêu chí lọc

huypham · 19/7/15

Cảm ơn các bác, mình áp dụng code của @giangleloi thấy chuẩn và đúng ý mình.

giangleloi đã viết:
Xem thử file này coi sao:

Mã:

Sub Loc()
Dim Arr(), Hp(1 To 10000, 1 To 3), I As Long, J As Long, K As Long
Dim DK As String, Hdk As Date
    With Sheet1
        Arr = .Range(.[A3], .[A65000].End(3)).Resize(, 5).Value
    End With
      Hdk = Sheet2.[B1].Value2
      DK = Sheet2.[B2].Value
        For I = 1 To UBound(Arr, 1)
              If Arr(I, 1) = Hdk And Arr(I, 4) = DK Then
                K = K + 1
                Hp(K, 1) = Arr(I, 2)
                Hp(K, 2) = Arr(I, 3)
                Hp(K, 3) = Arr(I, 5)
             ElseIf Arr(I, 4) = DK And Hdk = Empty Then
                K = K + 1
                Hp(K, 1) = Arr(I, 2)
                Hp(K, 2) = Arr(I, 3)
                Hp(K, 3) = Arr(I, 5)
             ElseIf Arr(I, 1) = Hdk And DK = Empty Then
                K = K + 1
                Hp(K, 1) = Arr(I, 2)
                Hp(K, 2) = Arr(I, 3)
                Hp(K, 3) = Arr(I, 5)
          End If
        Next
    With Sheet2
        .[A4:C10000].ClearContents
         If K Then .[A4].Resize(K, 3) = Hp
    End With
End Sub

Mình bắt chước code này để thêm code lọc danh sách NCC, chưa triệt để nhưng thấy ok rồi.

Mã:

Sub LOCNCC()Dim Arr(), Hp(1 To 10000, 1 To 3), I As Long, J As Long, K As Long
Dim Hdk As Date
    With Sheet1
        Arr = .Range(.[A3], .[A65000].End(3)).Resize(, 5).Value
    End With
        Hdk = Sheet2.[B1].Value2
    For I = 1 To UBound(Arr, 1)
        If Arr(I, 1) = Hdk Then
            K = K + 1
            Hp(K, 1) = Arr(I, 4)
        End If
    Next
        With Sheet5
        .[A2:A10000].ClearContents
         If K Then .[A2].Resize(K, 1) = Hp
        End With
        With Sheet5
        .[A2:A10000].RemoveDuplicates Columns:=1, Header:=xlNo
        End With
End Sub

Kiều Mạnh · 19/7/15

To huypham Bạn bỏ bớt một cái With Sheet5 đi cho chung lên trên luôn cho nó gọn
With Sheet5
.[A2:A10000].ClearContents
If K Then .[A2].Resize(K, 1) = Hp
End With
With Sheet5
.[A2:A10000].RemoveDuplicates Columns:=1, Header:=xlNo
End With

Hau151978 · 19/7/15

Trong code của bạn huypham có khai báo Dim Hdk As Date và Hdk=Sheet2.[B1].Value2
Theo mình đã khai báo kiểu Date thì nên dùng Value, tuy ở trường hợp này code chạy đúng nhưng bạn không nên lẫn lộn value và value2. Value2 chuyển đổi giá trị Date sang Number nhưng do Hdk có kiểu Date rồi nên Number lại được chuyển về kiểu Date, còn Value sẽ giữ nguyên kiểu Date.

Kiều Mạnh · 19/7/15

Hau151978 đã viết:
Trong code của bạn huypham có khai báo Dim Hdk As Date và Hdk=Sheet2.[B1].Value2
Theo mình đã khai báo kiểu Date thì nên dùng Value, tuy ở trường hợp này code chạy đúng nhưng bạn không nên lẫn lộn value và value2. Value2 chuyển đổi giá trị Date sang Number nhưng do Hdk có kiểu Date rồi nên Number lại được chuyển về kiểu Date, còn Value sẽ giữ nguyên kiểu Date.

Thấy bạn nói lại nhớ hôm Anh hải qua chỉ code Value & Value2..........Giờ mình thật sự hiểu Value Và Value2............Cảm ơn Bạn

PHP:

Sub Value_Value2()
    [A1] = Date
    [C1] = [A1].Value2
    [E1] = [A1].Value
End Sub

tungtruong8924 · 19/7/15

hpkhuong đã viết:
Xài 1 cột phụ (cột F tại sheet Tổng hợp nhé! (Công thức thì file đính kèm.)

Còn code thì thử cái này:

[GPECODE=vb]
Sub Loc()
Dim Sh As Worksheet, Arr(), zArr()
Dim Rws As Long, J&, W&, dk1 As Date, dk2 As String
dk1 = Sheets("CHI TIET").[B1].Value
dk2 = Sheets("CHI TIET").[B2].Value
zArr = Array(2, 3, 5)
Set Sh = Sheets("TONG HOP")
With Sh.[A2]
Rws = .CurrentRegion.Rows.Count
Arr() = .Resize(Rws, 5).Value
End With
ReDim dArr(1 To Rws, 1 To 3)
For J = 1 To UBound(Arr())
If Arr(J, 1) = dk1 And Arr(J, 4) = dk2 Then
W = 1 + W
For Z = 0 To UBound(zArr)
dArr(W, Z + 1) = Arr(J, zArr(Z))
Next Z
End If
Next J
If W Then
Sheets("CHI TIET").[A4].Resize(65000, 3).ClearContents
Sheets("CHI TIET").[A4].Resize(W, 3).Value = dArr()
End If
End Sub
[/GPECODE]

cảm ơn bạn đã chia sẻ, mình vừa làm được rồi, hi

giangleloi · 20/7/15

hpkhuong đã viết:
Name động làm list cho Source:

Mã:

=OFFSET([COLOR=#ff0000][B]Sheet1!$A$2,[/B][/COLOR],,COUNTA([COLOR=#ff0000]Sheet1!$A$2[/COLOR]:$A$1000))

Sheet1!$A$2: màu đỏ này bạn chỉnh cho đúng tên sheet thực tế mới thêm của bạn

Thế thì xài code để tạo Name luôn. Kiểu như thế này nè:

Mã:

Sub LOCNCC()
Dim Rng As Range
  Sheet1.Columns(4).Copy: Sheet3.[D1].PasteSpecial xlPasteValues
    With Sheet3
      .Columns(4).RemoveDuplicates Columns:=1, Header:=xlYes
      Set Rng = .Range("D2:D" & .Range("D" & Rows.Count).End(3).Row)
    ActiveWorkbook.Names.Add "NCC", Rng
    End With
End Sub

doveandrose · 20/7/15

giangleloi đã viết:
Thế thì xài code để tạo Name luôn. Kiểu như thế này nè:

Mã:

Sub LOCNCC() Dim Rng As Range Sheet1.Columns(4).Copy: Sheet3.[D1].PasteSpecial xlPasteValues With Sheet3 .Columns(4).RemoveDuplicates Columns:=1, Header:=xlYes Set Rng = .Range("D2:D" & .Range("D" & Rows.Count).End(3).Row) ActiveWorkbook.Names.Add "NCC", Rng End With End Sub

đã dùng code mà còn bị tốn 1 vùng trên sheet để lưu danh sách (tấc đất tấc vàng), rồi tốn thêm 1 named để đặt tên cho cái vùng đó nữa => chưa đi đến bến bờ ăn chơi )(&&@@

có cách nào thực hiện bằng code đúng như hình vẽ #10 không ta ? List Source hiện lên chính xác
NCC1,NCC2,NCC3

phihndhsp · 20/7/15

hpkhuong đã viết:
Cũng có suy nghỉ như bác vậy. Tốn đất.......... Mà nếu không có đất cắm dùi thì biết để ở đâu? Bác gán trực tiếp vào Source như hình vẽ được không? Hay ta thử record thao tác này xem................hihi

đừng tìm nữa? không có cách nào đâu, phải thông qua cái name thì mới được(theo như hiểu biết của tôi)

doveandrose · 20/7/15

phihndhsp đã viết:
đừng tìm nữa? không có cách nào đâu, phải thông qua cái name thì mới được(theo như hiểu biết của tôi)

em chém gió chơi chứ thật ra em cũng đâu biết làm =))
nhưng em biết chắc 1 điều
khi topic này kết thúc thì hiểu biết của anh sẽ khác đi đấy =))

phihndhsp · 20/7/15

cũng hy vọng là vậy. vì trước đây mấy năm tôi cũng hỏi mà chưa có câu trả lời cho validation lấy từ nguồn dữ liệu ra duy nhất

n0thing1988 · 20/7/15

Chủ đề đang hay. Liệu có ai giải đáp được thắc mắc của thầy Phi ko?
Đặt gạch hóng tiếp

giangleloi · 20/7/15

doveandrose đã viết:
em chém gió chơi chứ thật ra em cũng đâu biết làm =))
nhưng em biết chắc 1 điều
khi topic này kết thúc thì hiểu biết của anh sẽ khác đi đấy =))

Và code nó ở đây ( Hic hic hic)

huypham · 20/7/15

Code chuẩn luôn. Nhưng nên đặt tên là Hahaha --=0

phihndhsp · 20/7/15

phihndhsp đã viết:
cũng hy vọng là vậy. vì trước đây mấy năm tôi cũng hỏi mà chưa có câu trả lời cho validation lấy từ nguồn dữ liệu ra duy nhấ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

giangleloi · 20/7/15

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ã:

For I = K To DONGCUOI TEM = Replace(TEM, ",,", ",") Next

Em cũng làm theo hướng của anh luôn rồi. Nhưng cố đợi anh chàng cao siêu đó hỏi "đểu" nữa. "Người ấy" không phải dạng vừa. Hình như đoạn trên đấy không cần anh nhỉ? Chỉ vô Source mới thấy. Bên ngoài thì đâu ảnh hưởng )(&&@@

phihndhsp · 20/7/15

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

Kiều Mạnh · 20/7/15

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

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

doveandrose · 20/7/15

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ì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

giangleloi · 20/7/15

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

Kiều Mạnh · 20/7/15

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

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

doveandrose · 20/7/15

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..

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 ?

giangleloi · 20/7/15

doveandrose đã viết:
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 ?

Hình như là 1100 hay 1200 lận ấy. Muốn làm gạo cội luôn rùi hỉ. --=0

Kiều Mạnh · 20/7/15

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 ?

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]

doveandrose · 20/7/15

giangleloi đã viết:
Hình như là 1100 hay 1200 lận ấy. Muốn làm gạo cội luôn rùi hỉ.

tôi không nghĩ cuộc đời tôi có cái ngày đó . tôi chỉ quan tâm công việc hàng ngày của mình . lúc nào rảnh mới vào đây kiếm tụ điểm ăn chơi vào hỏi xoáy đáp xoay thôi .

Kiều Mạnh · 20/7/15

giangleloi đã viết:
Hình như là 1100 hay 1200 lận ấy. Muốn làm gạo cội luôn rùi hỉ.

Chắc viết mấy năm nữa sẽ trở thành Thành Viên Vừa Cạo Vừa Gội --=0

thế mới Vui

phihndhsp · 20/7/15

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

Let'GâuGâu · 20/7/15

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

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

phihndhsp · 20/7/15

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

Uhm ha, sao mình lại không nhớ ra cái dụ preverse này ta(-.-)

Kiều Mạnh · 20/7/15

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

Ý 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

Quang_Hải · 20/7/15

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

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ĩ.

Kiều Mạnh · 20/7/15

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

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

Quang_Hải · 20/7/15

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

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

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)) = ""

Kiều Mạnh · 20/7/15

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ĩ.

Em thấy chạy tốt mà có lỗi gì đâu

doveandrose · 20/7/15

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ĩ.

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 ?

Kiều Mạnh · 20/7/15

quanghai1969 đã viết:
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)) = ""

Thì Em đang Check các kiểu xem nó ra cái gì thôi

phihndhsp · 21/7/15

hpkhuong đã viết:
Oh.
1. Trường hợp đầu khi Dim Dic As Object, rồi Set Dic = ..... : như vậy nó làm cho dữ liệu ngày thành Value
2. Trường hợp code ở Quote bên trên: With CreateObject("scripting.dictionary"). Mà không cần Dim hay Set thì định dạng ngày nó lại không thay đổi.

Lý do tại sao như vậy nhỉ? Mong bác giải thích giúp!

bạn cho tôi trường hợp bạn gặp phải đi? vì tôi thấy không có sự khác biệt nào?
khai báo Dim rồi Set thì sẽ tường minh hơn (trong trường hợp sử dụng nhiều nơi)
còn sử dụng ít thì có thể tạo trực tiếp Create...., còn về dữ liệu thì nó như nhau không có khác biệt gì

phihndhsp · 21/7/15

hpkhuong đã viết:
Oh. Mới test lại code DIC, đúng thật là nó ra dạng ngày luôn. không hiểu sao hồi lúc test nó lại ra value mới ghê.hixhix........
Nếu không dùng DIC (mấy code không phải DIC ở topic này) nếu áp dụng ngày thì có để nguyên định dạng đưa vào Validation không anh? nếu được anh làm thử cho cái tham khảo nha!

Không sử dụng DIC

Mã:

Sub GPE()
    Dim Rng As Range
    Dim ArrD()
    Dim ArrN()
    Dim DongCuoi As Long
    Dim i As Long, j As Long
    Dim DongHienTai As Long
    DongCuoi = Sheet1.Range("A60000").End(xlUp).Row
    ArrN = Sheet1.Range("A2:A" & DongCuoi)
     ReDim ArrD(1)
     ArrD(1) = ArrN(1, 1)
     DongHienTai = 1
     flag = True
    For i = 1 To UBound(ArrN, 1)
        For j = 1 To DongHienTai
             If (ArrN(i, 1) = ArrD(j)) Then
               flag = False
               Exit For
             End If
        Next j
            If (flag = True) Then
                DongHienTai = DongHienTai + 1
                 ReDim Preserve ArrD(DongHienTai)
                ArrD(DongHienTai) = ArrN(i, 1)
            End If
            flag = True
     Next
     Range("G3").Validation.Delete
     Range("G3").Validation.Add xlValidateList, , , Join(ArrD, ",")
End Sub

giangleloi · 21/7/15

hpkhuong đã viết:
nếu áp dụng ngày thì có để nguyên định dạng đưa vào Validation không anh?

Quan trọng là cái chỗ mình đặt nó đang định dạng là kiểu gì thôi mà?

maiban1986 · 12/2/20

phihndhsp đã viết:

Không sử dụng DIC

Mã:

Sub GPE()
    Dim Rng As Range
    Dim ArrD()
    Dim ArrN()
    Dim DongCuoi As Long
    Dim i As Long, j As Long
    Dim DongHienTai As Long
    DongCuoi = Sheet1.Range("A60000").End(xlUp).Row
    ArrN = Sheet1.Range("A2:A" & DongCuoi)
     ReDim ArrD(1)
     ArrD(1) = ArrN(1, 1)
     DongHienTai = 1
     flag = True
    For i = 1 To UBound(ArrN, 1)
        For j = 1 To DongHienTai
             If (ArrN(i, 1) = ArrD(j)) Then
               flag = False
               Exit For
             End If
        Next j
            If (flag = True) Then
                DongHienTai = DongHienTai + 1
                 ReDim Preserve ArrD(DongHienTai)
                ArrD(DongHienTai) = ArrN(i, 1)
            End If
            flag = True
     Next
     Range("G3").Validation.Delete
     Range("G3").Validation.Add xlValidateList, , , Join(ArrD, ",")
End Sub

tuyệt vời.nhưng dữ liệu thêm vào được cập nhật tự động thì hay quá

Lọc mảng nhiều điều kiện (1 người xem)

Người dùng đang xem chủ đề này

Thành viên mới

File đính kèm

Be all you can be !

Thành viên gắn bó

Thành viên gắn bó

File đính kèm

hello

hello

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên mới

Thành viên gắn bó

Thành viên mới

Thành viên gắn bó

Thành viên mới

File đính kèm

Thành viên mới

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

File đính kèm

0901452không62

File đính kèm

Thành viên mới

I don't program, I beat code into submission!!!

Thành viên tích cực

I don't program, I beat code into submission!!!

Thành viên mới

Thành viên gắn bó

hello

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

hello

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

Mù VBA

Thành viên gắn bó

File đính kèm

Thành viên mới

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

File đính kèm

Thành viên gắn bó

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

I don't program, I beat code into submission!!!

hello

Thành viên gắn bó

I don't program, I beat code into submission!!!

hello

Thành viên gắn bó

I don't program, I beat code into submission!!!

hello

I don't program, I beat code into submission!!!

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

Thành viên mới

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

I don't program, I beat code into submission!!!

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

I don't program, I beat code into submission!!!

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

I don't program, I beat code into submission!!!

hello

I don't program, I beat code into submission!!!

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

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

Thành viên gắn bó

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

Thời gian đếm ngược.