mình cần trích tên từ các hàng trong sheet 1 sang sheet 2 với cùng số phòng thì thể hiện chung 1 hàng như ví dụ ạ! cảm ơn rất nhiều.

duykhanh2809 · 3/11/19

dazkangel · 3/11/19

Thử:

huonglien1901 · 3/11/19

PHP:

Option Explicit
Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, arrDes(), Item, tmp As String
  Dim idx As Long, n As Long
  'On Error Resume Next
  For idx = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(idx)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = CStr(Item)
        n = n + 1
        ReDim Preserve arrDes(1 To n)
        arrDes(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(arrDes, Delimiter)
End Function
Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr, tmp
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
      For Each Item In tmpArr
        If TypeName(Item) <> "Error" Then
          tmp = CStr(Item)
          If Len(tmp) Then
            If Not .Exists(tmp) Then .Add tmp, ""
          End If
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function
Function JoinIf(ByVal Delimiter As String, ByVal CriteriaArray, ByVal Criteria, Optional ByVal TargetArray) As String
  Dim arrDes()
  Dim arrTmpCrit    As Variant
  Dim arrTmpDest    As Variant
  Dim strCrit       As Variant
  Dim strDest       As Variant
  Dim dic           As Object
  Dim bComp         As Boolean
  Dim idx           As Long
  Dim dTmpVal       As Double
 
  Set dic = CreateObject("Scripting.Dictionary")
  If IsMissing(TargetArray) Then TargetArray = CriteriaArray
  arrTmpCrit = ConvertTo1DArray(CriteriaArray)
  arrTmpDest = ConvertTo1DArray(TargetArray)
  If (Not IsArray(arrTmpCrit)) Or (Not IsArray(arrTmpDest)) Then Exit Function
  'On Error Resume Next
  bComp = (InStr("<>=", Left(Criteria, 1)) > 0)
  For idx = LBound(arrTmpDest) To UBound(arrTmpDest)
    strCrit = arrTmpCrit(idx): strDest = arrTmpDest(idx)
    If TypeName(strCrit) <> "Error" Then
      If TypeName(strDest) <> "Error" Then
        If bComp And Len(Criteria) Then
          dTmpVal = CDbl(arrTmpCrit(idx))
          If Evaluate(dTmpVal & Criteria) Then
            If Not dic.Exists(strDest) Then dic.Add strDest, ""
          End If
        Else
          If (Left(Criteria, 1) = "!") Then
            If Not (UCase(strCrit) Like UCase(Mid(Criteria, 2))) Then
              If Not dic.Exists(strDest) Then dic.Add strDest, ""
            End If
          Else
            If (UCase(strCrit) Like UCase(Criteria)) Then
              If Not dic.Exists(strDest) Then dic.Add strDest, ""
            End If
          End If
        End If
      End If
    End If
  Next
  If dic.Count Then
    arrDes = dic.Keys
    JoinIf = Join(arrDes, Delimiter)
  End If
  'If Err.Number Then MsgBox Err.Description
End Function
Private Function ConvertTo1DArray(ByVal SourceArray)
  Dim arrDest()
  Dim arrSrc    As Variant
  Dim Item      As Variant
  Dim idx       As Long
  'On Error Resume Next
  arrSrc = SourceArray
  If Not IsArray(arrSrc) Then arrSrc = Array(arrSrc)
  For Each Item In arrSrc
    idx = idx + 1
    ReDim Preserve arrDest(1 To idx)
    arrDest(idx) = Item
  Next
  ConvertTo1DArray = arrDest
  'If Err.Number Then MsgBox Err.Description
End Function

Bạn thử công thức này.

PHP:

=JoinText(",",IF(Sheet1!$A$2:$A$16=Sheet2!$A2,TRIM(RIGHT(SUBSTITUTE(Sheet1!$B$2:$B$16," ",REPT(" ",150)),150)),1/0))

nhấn CTRL+SHIFT+ENTER. rồi fill xuống.

duykhanh2809 đã viết:
mình cần trích tên từ các hàng trong sheet 1 sang sheet 2 với cùng số phòng thì thể hiện chung 1 hàng như ví dụ ạ! cảm ơn rất nhiều.

Bạn thử tìm hàm joinif và jointext của Thầy ndu thử xem.

duykhanh2809 · 10/12/19

dazkangel đã viết:
Thử:

thanks bạn rất nhiều. mình gà quá nên xem nhiều bài HD vẫn không làm được, cuối cùng nhờ bạn cũng xong!

Bài đã được tự động gộp: 10/12/19

huonglien1901 đã viết:

PHP:

Option Explicit
Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, arrDes(), Item, tmp As String
  Dim idx As Long, n As Long
  'On Error Resume Next
  For idx = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(idx)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = CStr(Item)
        n = n + 1
        ReDim Preserve arrDes(1 To n)
        arrDes(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(arrDes, Delimiter)
End Function
Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr, tmp
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
      For Each Item In tmpArr
        If TypeName(Item) <> "Error" Then
          tmp = CStr(Item)
          If Len(tmp) Then
            If Not .Exists(tmp) Then .Add tmp, ""
          End If
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function
Function JoinIf(ByVal Delimiter As String, ByVal CriteriaArray, ByVal Criteria, Optional ByVal TargetArray) As String
  Dim arrDes()
  Dim arrTmpCrit    As Variant
  Dim arrTmpDest    As Variant
  Dim strCrit       As Variant
  Dim strDest       As Variant
  Dim dic           As Object
  Dim bComp         As Boolean
  Dim idx           As Long
  Dim dTmpVal       As Double

  Set dic = CreateObject("Scripting.Dictionary")
  If IsMissing(TargetArray) Then TargetArray = CriteriaArray
  arrTmpCrit = ConvertTo1DArray(CriteriaArray)
  arrTmpDest = ConvertTo1DArray(TargetArray)
  If (Not IsArray(arrTmpCrit)) Or (Not IsArray(arrTmpDest)) Then Exit Function
  'On Error Resume Next
  bComp = (InStr("<>=", Left(Criteria, 1)) > 0)
  For idx = LBound(arrTmpDest) To UBound(arrTmpDest)
    strCrit = arrTmpCrit(idx): strDest = arrTmpDest(idx)
    If TypeName(strCrit) <> "Error" Then
      If TypeName(strDest) <> "Error" Then
        If bComp And Len(Criteria) Then
          dTmpVal = CDbl(arrTmpCrit(idx))
          If Evaluate(dTmpVal & Criteria) Then
            If Not dic.Exists(strDest) Then dic.Add strDest, ""
          End If
        Else
          If (Left(Criteria, 1) = "!") Then
            If Not (UCase(strCrit) Like UCase(Mid(Criteria, 2))) Then
              If Not dic.Exists(strDest) Then dic.Add strDest, ""
            End If
          Else
            If (UCase(strCrit) Like UCase(Criteria)) Then
              If Not dic.Exists(strDest) Then dic.Add strDest, ""
            End If
          End If
        End If
      End If
    End If
  Next
  If dic.Count Then
    arrDes = dic.Keys
    JoinIf = Join(arrDes, Delimiter)
  End If
  'If Err.Number Then MsgBox Err.Description
End Function
Private Function ConvertTo1DArray(ByVal SourceArray)
  Dim arrDest()
  Dim arrSrc    As Variant
  Dim Item      As Variant
  Dim idx       As Long
  'On Error Resume Next
  arrSrc = SourceArray
  If Not IsArray(arrSrc) Then arrSrc = Array(arrSrc)
  For Each Item In arrSrc
    idx = idx + 1
    ReDim Preserve arrDest(1 To idx)
    arrDest(idx) = Item
  Next
  ConvertTo1DArray = arrDest
  'If Err.Number Then MsgBox Err.Description
End Function

Bạn thử công thức này.

PHP:

=JoinText(",",IF(Sheet1!$A$2:$A$16=Sheet2!$A2,TRIM(RIGHT(SUBSTITUTE(Sheet1!$B$2:$B$16," ",REPT(" ",150)),150)),1/0))

nhấn CTRL+SHIFT+ENTER. rồi fill xuống.

Bạn thử tìm hàm joinif và jointext của Thầy ndu thử xem.

huonglien1901 đã viết:

PHP:

Option Explicit
Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, arrDes(), Item, tmp As String
  Dim idx As Long, n As Long
  'On Error Resume Next
  For idx = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(idx)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = CStr(Item)
        n = n + 1
        ReDim Preserve arrDes(1 To n)
        arrDes(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(arrDes, Delimiter)
End Function
Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr, tmp
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
      For Each Item In tmpArr
        If TypeName(Item) <> "Error" Then
          tmp = CStr(Item)
          If Len(tmp) Then
            If Not .Exists(tmp) Then .Add tmp, ""
          End If
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function
Function JoinIf(ByVal Delimiter As String, ByVal CriteriaArray, ByVal Criteria, Optional ByVal TargetArray) As String
  Dim arrDes()
  Dim arrTmpCrit    As Variant
  Dim arrTmpDest    As Variant
  Dim strCrit       As Variant
  Dim strDest       As Variant
  Dim dic           As Object
  Dim bComp         As Boolean
  Dim idx           As Long
  Dim dTmpVal       As Double

  Set dic = CreateObject("Scripting.Dictionary")
  If IsMissing(TargetArray) Then TargetArray = CriteriaArray
  arrTmpCrit = ConvertTo1DArray(CriteriaArray)
  arrTmpDest = ConvertTo1DArray(TargetArray)
  If (Not IsArray(arrTmpCrit)) Or (Not IsArray(arrTmpDest)) Then Exit Function
  'On Error Resume Next
  bComp = (InStr("<>=", Left(Criteria, 1)) > 0)
  For idx = LBound(arrTmpDest) To UBound(arrTmpDest)
    strCrit = arrTmpCrit(idx): strDest = arrTmpDest(idx)
    If TypeName(strCrit) <> "Error" Then
      If TypeName(strDest) <> "Error" Then
        If bComp And Len(Criteria) Then
          dTmpVal = CDbl(arrTmpCrit(idx))
          If Evaluate(dTmpVal & Criteria) Then
            If Not dic.Exists(strDest) Then dic.Add strDest, ""
          End If
        Else
          If (Left(Criteria, 1) = "!") Then
            If Not (UCase(strCrit) Like UCase(Mid(Criteria, 2))) Then
              If Not dic.Exists(strDest) Then dic.Add strDest, ""
            End If
          Else
            If (UCase(strCrit) Like UCase(Criteria)) Then
              If Not dic.Exists(strDest) Then dic.Add strDest, ""
            End If
          End If
        End If
      End If
    End If
  Next
  If dic.Count Then
    arrDes = dic.Keys
    JoinIf = Join(arrDes, Delimiter)
  End If
  'If Err.Number Then MsgBox Err.Description
End Function
Private Function ConvertTo1DArray(ByVal SourceArray)
  Dim arrDest()
  Dim arrSrc    As Variant
  Dim Item      As Variant
  Dim idx       As Long
  'On Error Resume Next
  arrSrc = SourceArray
  If Not IsArray(arrSrc) Then arrSrc = Array(arrSrc)
  For Each Item In arrSrc
    idx = idx + 1
    ReDim Preserve arrDest(1 To idx)
    arrDest(idx) = Item
  Next
  ConvertTo1DArray = arrDest
  'If Err.Number Then MsgBox Err.Description
End Function

Bạn thử công thức này.

PHP:

=JoinText(",",IF(Sheet1!$A$2:$A$16=Sheet2!$A2,TRIM(RIGHT(SUBSTITUTE(Sheet1!$B$2:$B$16," ",REPT(" ",150)),150)),1/0))

nhấn CTRL+SHIFT+ENTER. rồi fill xuống.

Bạn thử tìm hàm joinif và jointext của Thầy ndu thử xem.

mình gà quá nên không hiểu lắm. mình phải tao macro như trên rồi mới sử dụng hàm bên dưới đc ah? vì mình thử coppy hàm đó vào bảng tính nhưng nó báo NAME?

be_09 · 11/12/19

duykhanh2809 đã viết:
mình cần trích tên từ các hàng trong sheet 1 sang sheet 2 với cùng số phòng thì thể hiện chung 1 hàng như ví dụ ạ! cảm ơn rất nhiều.

Bạn sử dụng thử File. Khi sử dụng cần lưu ý mấy vấn đề sau:
1/ Copy dữ liệu Paste vào sheet Du_Lieu, tại C2 bạn gõ tên tương ứng với B2, ví dụ tại C2 sheet1 tôi gõ sẳn tên là Điền.
2/ Sang sheet Tach bạn nhấn nút để xem kết quả, trường hợp sheet Du_Lieu hơn 16 dòng và số phòng lớn hơn 8 thì bạn vào G2 sửa lại hàm rồi Fill xuống.

be_09 · 12/12/19

duykhanh2809 đã viết:
Cảm ơn bạn rất nhiều. mình gà quá nên xem nhiều bài HD vẫn không làm được, cuối cùng nhờ bạn cũng xong!
Mình gà quá nên không hiểu lắm. mình phải tao macro như trên rồi mới sử dụng hàm bên dưới đc ah? vì mình thử coppy hàm đó vào bảng tính nhưng nó báo NAME?

Tôi cải tiến lại File bài 5.
Khi copy dữ liệu và Paste vào sheet Du_Lieu và tại C2 chỉ cần gõ tên tương ứng với tên ở B2 rồi nhấn nút là có kết quả luôn chẳng cần phải thao tác gì nữa cả.

mình cần trích tên từ các hàng trong sheet 1 sang sheet 2 với cùng số phòng thì thể hiện chung 1 hàng như ví dụ ạ! cảm ơn rất nhiều.

duykhanh2809

Thành viên mới

File đính kèm

dazkangel

<New Horizons>

File đính kèm

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!

duykhanh2809

Thành viên mới

be_09

Biên Hòa, Đồng Nai

File đính kèm

be_09

Biên Hòa, Đồng Nai

File đính kèm

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

Facebook

Group

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