Hàm liệt kê tất cả danh sách có mặt trong các cột

hongphuong1997 · 27/2/19

Nhờ các thầy và anh chị viết giúp hàm như file đính kèm

vanaccex · 27/2/19

Bạn thử dùng hàm này xem. Hàm này bạn đã đăng ở 1 bài viết còn của bạn hỏi về hàm này !

https://giaiphapexcel.com/diendan/threads/giải-thích-và-hướng-dẫn-sử-dụng-hàm.140217/#post-901298

Mình có sửa dòng cuối để chuyển từ ngang sang dọc thôi

If dic.Count Then UniqueList = dic.Keys

Thành

If .Count Then UniqueList = WorksheetFunction.transpose(.Keys)

Mã:

Function UniqueList(ParamArray arrays())
  Dim iTem, aTmpArr, aSubArr
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each aSubArr In arrays
      aTmpArr = aSubArr
      If Not IsArray(aTmpArr) Then aTmpArr = Array(aTmpArr)
      For Each iTem In aTmpArr
        If TypeName(iTem) <> "Error" Then
          If Len(iTem) Then
            If Not .Exists(iTem) Then .ADD iTem, Empty
          End If
        End If
      Next
    Next
    If .Count Then UniqueList = WorksheetFunction.transpose(.Keys)
  End With
End Function

Cách sử dụng thì bạn

R4 = UniqueList(D443;J4:J43;G4:G43))

Ban bôi đen vùng cần chứa kết quả và kết thúc bằng 3 phím Ctr + shift + ent

chiendich · 27/2/19

hongphuong1997 đã viết:
Nhờ các thầy và anh chị viết giúp hàm như file đính kèm

code nhé!

hongphuong1997 · 27/2/19

vanaccex đã viết:
Bạn thử dùng hàm này xem. Hàm này bạn đã đăng ở 1 bài viết còn của bạn hỏi về hàm này !

Mình có sửa dòng cuối để chuyển từ ngang sang dọc thôi

Thành

Mã:

Function UniqueList(ParamArray arrays()) Dim iTem, aTmpArr, aSubArr 'On Error Resume Next With CreateObject("Scripting.Dictionary") For Each aSubArr In arrays aTmpArr = aSubArr If Not IsArray(aTmpArr) Then aTmpArr = Array(aTmpArr) For Each iTem In aTmpArr If TypeName(iTem) <> "Error" Then If Len(iTem) Then If Not .Exists(iTem) Then .ADD iTem, Empty End If End If Next Next If .Count Then UniqueList = WorksheetFunction.transpose(.Keys) End With End Function

Cách sử dụng thì bạn
Ban bôi đen vùng cần chứa kết quả và kết thúc bằng 3 phím Ctr + shift + ent

Em cảm ơn chị:
Chị
vanaccex

cho em hỏi hàm này của bác @ndu96081631 để làm gì hở chị?
Private Function ConvertTo1DArray(ByVal SourceArray)
Dim aDest() As Variant
Dim aSource As Variant
Dim item As Variant
Dim idx As Long
'On Error Resume Next
aSource = SourceArray
If Not IsArray(aSource) Then aSource = Array(aSource)
For Each item In aSource
idx = idx + 1
ReDim Preserve aDest(1 To idx)
aDest(idx) = item
Next
ConvertTo1DArray = aDest
'If Err.Number Then MsgBox Err.Description
End Function

SA_DQ · 27/2/19

Tham gia 1 macro chân phương là vầy

PHP:

Sub TaoDanhSachKhongTrungTu3Cot()
 Dim Rws As Long, J As Long, W As Integer
 Dim Dict As Object, Rng As Range, Cls As Range

Set Dict = CreateObject("Scripting.Dictionary")
Rws = [d4].CurrentRegion.Rows.Count
Set Rng = Union([d4].Resize(Rws), [g4].Resize(Rws), [J4].Resize(Rws))
ReDim Arr(1 To Rng.Rows.Count, 1 To 1) As String
For Each Cls In Rng
    If Not Dict.exists(Cls.Value) Then
        W = W + 1:                  Arr(W, 1) = Cls.Value
        Dict.Add Cls.Value, W
    End If
Next Cls
If W Then
    [v4].Resize(W).Value = Arr()
End If
End Sub

hongphuong1997 · 27/2/19

SA_DQ đã viết:

Tham gia 1 macro chân phương là vầy

PHP:

Sub TaoDanhSachKhongTrungTu3Cot()
Dim Rws As Long, J As Long, W As Integer
Dim Dict As Object, Rng As Range, Cls As Range

Set Dict = CreateObject("Scripting.Dictionary")
Rws = [d4].CurrentRegion.Rows.Count
Set Rng = Union([d4].Resize(Rws), [g4].Resize(Rws), [J4].Resize(Rws))
ReDim Arr(1 To Rng.Rows.Count, 1 To 1) As String
For Each Cls In Rng
    If Not Dict.exists(Cls.Value) Then
        W = W + 1:                  Arr(W, 1) = Cls.Value
        Dict.Add Cls.Value, W
    End If
Next Cls
If W Then
    [v4].Resize(W).Value = Arr()
End If
End Sub

Cháu cảm ơn bác!
Bác @SA_DQ ơi nhưng cháu thích dùng hàm bác ơi.

SA_DQ · 27/2/19

Bác ơi nhưng cháu thích dùng hàm bác ơi.

Thì chờ các siêu công thức ngang qua ra tay vậy!

Chúc vui!

hongphuong1997 · 28/2/19

vanaccex đã viết:
Bạn thử dùng hàm này xem. Hàm này bạn đã đăng ở 1 bài viết còn của bạn hỏi về hàm này !

Mình có sửa dòng cuối để chuyển từ ngang sang dọc thôi

Thành

Mã:

Function UniqueList(ParamArray arrays()) Dim iTem, aTmpArr, aSubArr 'On Error Resume Next With CreateObject("Scripting.Dictionary") For Each aSubArr In arrays aTmpArr = aSubArr If Not IsArray(aTmpArr) Then aTmpArr = Array(aTmpArr) For Each iTem In aTmpArr If TypeName(iTem) <> "Error" Then If Len(iTem) Then If Not .Exists(iTem) Then .ADD iTem, Empty End If End If Next Next If .Count Then UniqueList = WorksheetFunction.transpose(.Keys) End With End Function

Cách sử dụng thì bạn
Ban bôi đen vùng cần chứa kết quả và kết thúc bằng 3 phím Ctr + shift + ent

Em cảm ơn chị, hàm rất đúng rồi chị ơi
Bây giờ em muốn hàm chỉ lấy các dữ liệu xuất hiện 1 lần thì làm như nào hở chị?
(Tức là những dữ liệu nào xuất hiện 2 lần trở lên thì loại đi)
Chị giúp em với nhé.

hocexcel_1991 · 28/2/19

hongphuong1997 đã viết:
Cháu cảm ơn bác!
Bác @SA_DQ ơi nhưng cháu thích dùng hàm bác ơi.

Thử dùng hàm của a @Phan Thế Hiệp và @dazkangel nhé

Mã:

R4=IFERROR(INDEX(T(OFFSET($D$4,MOD(ROW($1:$150)-1,50),INT((ROW($1:$150)-1)/50)*3)),MATCH(,INDEX(COUNTIF($R$3:R3,T(OFFSET($D$4,MOD(ROW($1:$150)-1,50),INT((ROW($1:$150)-1)/50)*3))),),0)),"")
OR
S4=IFERROR(INDIRECT(MID(REPT(TEXT(AGGREGATE(15,6,(COLUMN(C:L)*1000+ROW($4:$43))/ISTEXT($C$4:$L$43)/(COUNTIF(S$3:S3,$C$4:$L$43)=0),1),"C000R000"),2),5,8),0),"")

dazkangel · 28/2/19

hocexcel_1991 đã viết:

Thử dùng hàm của a @Phan Thế Hiệp và @dazkangel nhé

Mã:

R4=IFERROR(INDEX(T(OFFSET($D$4,MOD(ROW($1:$150)-1,50),INT((ROW($1:$150)-1)/50)*3)),MATCH(,INDEX(COUNTIF($R$3:R3,T(OFFSET($D$4,MOD(ROW($1:$150)-1,50),INT((ROW($1:$150)-1)/50)*3))),),0)),"")
OR
S4=IFERROR(INDIRECT(MID(REPT(TEXT(AGGREGATE(15,6,(COLUMN(C:L)*1000+ROW($4:$43))/ISTEXT($C$4:$L$43)/(COUNTIF(S$3:S3,$C$4:$L$43)=0),1),"C000R000"),2),5,8),0),"")

Hàm này mình học từ anh huu_thang đó

Phan Thế Hiệp · 28/2/19

hocexcel_1991 đã viết:

Thử dùng hàm của a @Phan Thế Hiệp và @dazkangel nhé

Mã:

R4=IFERROR(INDEX(T(OFFSET($D$4,MOD(ROW($1:$150)-1,50),INT((ROW($1:$150)-1)/50)*3)),MATCH(,INDEX(COUNTIF($R$3:R3,T(OFFSET($D$4,MOD(ROW($1:$150)-1,50),INT((ROW($1:$150)-1)/50)*3))),),0)),"")
OR
S4=IFERROR(INDIRECT(MID(REPT(TEXT(AGGREGATE(15,6,(COLUMN(C:L)*1000+ROW($4:$43))/ISTEXT($C$4:$L$43)/(COUNTIF(S$3:S3,$C$4:$L$43)=0),1),"C000R000"),2),5,8),0),"")

Học của người là 1 chuyện, biết vận dụng cái học được làm phù hợp với dữ liệu thực tế lại là chuyện khác.

Đáng khen! và rất mừng cho em :<>

chiendich · 28/2/19

hongphuong1997 đã viết:
Cháu cảm ơn bác!
Bác @SA_DQ ơi nhưng cháu thích dùng hàm bác ơi.

Muốn dùng hàm tự tạo nhé!

hongphuong1997 · 28/2/19

chiendich đã viết:
Muốn dùng hàm tự tạo nhé!

Em cảm ơn anh
Bây giờ em muốn hàm chỉ lấy các dữ liệu xuất hiện 1 lần thì làm như nào hở anh?
(Tức là những dữ liệu nào xuất hiện 2 lần trở lên thì loại đi)

snow25 · 28/2/19

hongphuong1997 đã viết:
Em cảm ơn anh
Bây giờ em muốn hàm chỉ lấy các dữ liệu xuất hiện 1 lần thì làm như nào hở anh?
(Tức là những dữ liệu nào xuất hiện 2 lần trở lên thì loại đi)

Đây em xem có đúng không nhé.

Mã:

Function loc(ParamArray mang())
      Dim T, arr, i As Long, dic As Object, T1, a As Long, s As String
      Set dic = CreateObject("scripting.dictionary")
      For Each T In mang
         For Each T1 In T
            s = T1.Value
             If Not dic.exists(s) Then
                dic.Add s, 1
             Else
                dic.Item(s) = dic.Item(s) + 1
             End If
         Next
      Next
      ReDim arr(1 To dic.Count, 1 To 1)
     For Each T In dic.Keys
        If dic.Item(T) = 1 Then
           a = a + 1
           arr(a, 1) = T
        End If
      Next
      If a Then loc = arr
End Function
Function loctrung(ParamArray mang())
       Dim T, dic As Object, T1, dic1 As Object, s As String
       Set dic = CreateObject("scripting.dictionary")
       Set dic1 = CreateObject("scripting.dictionary")
       For Each T In mang
         For Each T1 In T
            s = T1.Value
          If Not dic1.exists(s) Then
            If Not dic.exists(s) Then
               dic.Add s, "KK"
            Else
               dic.Remove s
               dic1.Add s, "KK"
            End If
          End If
        Next
      Next
      If dic.Count Then loctrung = WorksheetFunction.Transpose(dic.Keys)
      Set dic = Nothing
      Set dic1 = Nothing
End Function

hongphuong1997 · 28/2/19

snow25 đã viết:

Đây em xem có đúng không nhé.

Mã:

Function loc(ParamArray mang())
      Dim T, arr, i As Long, dic As Object, T1, a As Long, s As String
      Set dic = CreateObject("scripting.dictionary")
      For Each T In mang
         For Each T1 In T
            s = T1.Value
             If Not dic.exists(s) Then
                dic.Add s, 1
             Else
                dic.Item(s) = dic.Item(s) + 1
             End If
         Next
      Next
      ReDim arr(1 To dic.Count, 1 To 1)
     For Each T In dic.Keys
        If dic.Item(T) = 1 Then
           a = a + 1
           arr(a, 1) = T
        End If
      Next
      If a Then loc = arr
End Function
Function loctrung(ParamArray mang())
       Dim T, dic As Object, T1, dic1 As Object, s As String
       Set dic = CreateObject("scripting.dictionary")
       Set dic1 = CreateObject("scripting.dictionary")
       For Each T In mang
         For Each T1 In T
            s = T1.Value
          If Not dic1.exists(s) Then
            If Not dic.exists(s) Then
               dic.Add s, "KK"
            Else
               dic.Remove s
               dic1.Add s, "KK"
            End If
          End If
        Next
      Next
      If dic.Count Then loctrung = WorksheetFunction.Transpose(dic.Keys)
      Set dic = Nothing
      Set dic1 = Nothing
End Function

Em cảm ơn anh rất nhiều
Đúng roài anh ơi.
Nhưng mà anh sửa giúp em là nếu không có kết quả thì là "No"
Hiện tại công thức ra kết quả là "0" và "N/A"

Hàm liệt kê tất cả danh sách có mặt trong các cột

hongphuong1997

Thành viên tiêu biểu

File đính kèm

vanaccex

Thành viên tiêu biểu

chiendich

Lỡ bước sang ngang

File đính kèm

hongphuong1997

Thành viên tiêu biểu

SA_DQ

/(hông là gì!

hongphuong1997

Thành viên tiêu biểu

SA_DQ

/(hông là gì!

hongphuong1997

Thành viên tiêu biểu

hocexcel_1991

Bắt đầu học Excel

dazkangel

<New Horizons>

Phan Thế Hiệp

-⍟-

chiendich

Lỡ bước sang ngang

File đính kèm

hongphuong1997

Thành viên tiêu biểu

snow25

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

hongphuong1997

Thành viên tiêu biểu

File đính kèm

Bài viết mới nhất

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