Если значение дубликата ячейки равно столбцу, то возвращаемое значение

Question

Мне нужно отслеживать человека в листе данных, чтобы определить, из какого места в какое место перемещается человек.

Если человек появляется более одного раза в колонке J означает, что человек изменил расположение и значение местоположения находится в колонке L. Для этого у меня есть следующий код:

=IF(J18=J19;IF(COUNTIF(J:J;J18)>1; "From "&L18 &" to "& IF(J18=J19;L19;"");"");"") 

Проблема заключается в том если человек меняет место более двух раз. В столбце O до столбца AA у меня есть месяцы года, определяющие местоположение человека.

Как я могу изменить этот код, чтобы сделать выше:

=IF(J18=J19;IF(COUNTIF(J:J;J18)>1; "From "&L18 &" to "& IF(J18=J19;L19;"");"");"") 

Answer 1

Вот User Defined Function (ака UDF) для выполнения этой задачи.

Function my_Travels(nm As Range, loc As Range, cal As Range) 
    Dim n As Long, cnt As Long, v As Long, vLOCs As Variant, vTMPs As Variant 
    Dim iLOC As Long, sTMP As String 

    my_Travels = vbNullString '"no travels" 
    cnt = Application.CountIf(nm.EntireColumn, nm(1)) 

    If Application.CountIf(nm, nm(1)) = cnt And cnt > 1 Then 
     Set loc = loc.Rows(1).Resize(nm.Rows.Count, loc.Columns.Count) 
     Set cal = cal.Rows(1).Resize(nm.Rows.Count, cal.Columns.Count) 

     'seed the array 
     ReDim vLOCs(1 To cnt, 1 To cnt) 
     For v = LBound(vLOCs, 1) To UBound(vLOCs, 1) 
      vLOCs(v, 1) = cal.Columns.Count + 1 
      vLOCs(v, 2) = cal.Columns.Count + 1 
     Next v 

     'collect the values into the array 
     For n = 1 To nm.Rows.Count 
      If nm.Cells(n, 1).Value2 = nm.Cells(1, 1).Value2 Then 
       iLOC = Application.Match(1, Application.Index(cal, n, 0), 0) 
       For v = LBound(vLOCs, 1) To UBound(vLOCs, 1) 
        If vLOCs(v, 1) = cal.Columns.Count + 1 Then 
         vLOCs(v, 1) = iLOC 
         vLOCs(v, 2) = n 
         Exit For 
        End If 
       Next v 
      End If 
     Next n 

     'sort the values in the array 
     For v = LBound(vLOCs, 1) To (UBound(vLOCs, 1) - 1) 
      For n = (v + 1) To UBound(vLOCs, 1) 
       If vLOCs(v, 1) > vLOCs(n, 1) Then 
        vTMPs = Array(vLOCs(v, 1), vLOCs(v, 2)) 
        vLOCs(v, 1) = vLOCs(n, 1) 
        vLOCs(v, 2) = vLOCs(n, 2) 
        vLOCs(n, 1) = vTMPs(0) 
        vLOCs(n, 2) = vTMPs(1) 
        Exit For 
       End If 
      Next n 
     Next v 

     'concatenate the locations from the array 
     For v = LBound(vLOCs) To (UBound(vLOCs) - 1) 
      sTMP = sTMP & "From " & loc.Cells(vLOCs(v, 2), 1) & " to " & loc.Cells(vLOCs(v + 1, 2), 1) & "; " 
     Next v 

     'truncate the string and return it 
     sTMP = Left(sTMP, Len(sTMP) - 2) 
     my_Travels = sTMP 

    End If 

End Function 

В МЕСТОПОЛОЖЕНИЕ и Календарь клетки должны только быть определены в первом ряду. Каждый из них имеет свою высоту (то есть строк) переопределен для поддержания согласованности со списком имен.

В АВ2 (как указано выше) формула,

=my_Travels(J2:J$8, L2, O2:AA2) 

Заполните вниз по мере необходимости.