https://maps.googleapis.com/maps/api/directions/json?origin=[Адрес старта]&destination=[Адрес назначения]&key=[Ваш Directions API ключ]

PersonActivityCounterDesc=VAR curVal = [CreatedOn]
VAR curPerson = 'Таблица1'[Имя]
RETURN
CALCULATE(RANK.EQ(curVal; [CreatedOn];DESC); FILTER(ALL('Таблица1');'Таблица1'[Имя] = curPerson))

    Dim errRn As Range
    ' Selection = Текущие выделенные ячейки
    For Each ccell In Selection
        If IsError(ccell) Then
            If errRn Is Nothing Then
                Set errRn = ccell
            Else
                Set errRn = Union(errRn, ccell)
            End If
        End If
    Next ccell
    If Not errRn Is Nothing Then
        'Значение для замены
        errRn.Value = " "
    End If
End Sub

{=ИНДЕКС($E$3:$E$241;ПОИСКПОЗ(1;--(КОРЕНЬ((B3-$F$3:$F$241)^2+(C3-$G$3:$G$241)^2)=МИН(КОРЕНЬ((B3-$F$3:$F$241)^2+(C3-$G$3:$G$241)^2))););1)}

Option Explicit
Option Compare Text

Sub XXXX()
...
Dim replaceRn As Range, inputRn As Range, replacementsRn As Range, startingWordsToIgnoreRn As Range, rrow As Range, proceed As String, wordRn As Range, word As String, where_to_replace_cell As Range
    ' Определяем диапазон со значениями для замен
    With ThisWorkbook.Sheets("Замена")
        ' Фразы для замены
        Set replacementsRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1))
        ' Если ячейка начинается на эти слова - не делаем замену
        Set startingWordsToIgnoreRn = Range(.Cells(2, 4), .Cells(.Rows.Count, 4).End(xlUp))
    End With
    
    With ThisWorkbook.Sheets("Поиск")
        ' Устанавливаем стартовый диапазон
        Set replaceRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
        ' Выделяем стартовый диапазон
        replaceRn.Parent.Activate
        replaceRn.Select
        ' Выведем запрос на изменение диапазона
        On Error Resume Next
        Set inputRn = Application.InputBox( _
                        Prompt:="Адрес для массовой замены", _
                        Title:="Замена по списку", _
                        Default:=replaceRn.Address(True, True, xlA1, True), _
                        Type:=8)
        Err.Clear
        On Error GoTo 0
        ' Если пользователь отменил выделение - выйдем из макроса с предупреждением
        If Not inputRn Is Nothing Then
            Set replaceRn = inputRn
        Else
            MsgBox "Диапазон не выбран", vbCritical
            Exit Sub
        End If
    End With
    
    For Each where_to_replace_cell In replaceRn.Cells
    ' По умолчанию - обрабытываем ячейку
        proceed = True
        ' Проверяем наличие слов из списка
        For Each wordRn In startingWordsToIgnoreRn
            word = wordRn.Value
            If Left(where_to_replace_cell.Cells(1, 1).Value, Len(word)) = word Then
                proceed = False
                Exit For
            End If
        Next wordRn
        ' Если нет слов из списка - начинаем замену.
        If proceed Then
            ' Для каждой пары заменяемых значений сделаем замену
            For Each rrow In replacementsRn.Rows
                where_to_replace_cell.Replace What:=rrow.Cells(1, 1).Value, Replacement:=rrow.Cells(1, 2).Value
            Next rrow
        End If
    
    Next where_to_replace_cell
    ' Выведем сообщение о завершении работы (можно убрать)
    MsgBox "Done!", vbInformation
End Sub

    ' Для каждой пары заменяемых значений сделаем замену
    For Each rrow In replaceRn.Rows
        ' По умолчанию - обрабытываем ячейку
        proceed = True

    ' Для каждой пары заменяемых значений сделаем замену
    For Each rrow In replacementsRn.Rows
        ' По умолчанию - обрабытываем ячейку
        proceed = True

Sub replaceByList()
    Dim replaceRn As Range, inputRn As Range, replacementsRn As Range
    ' Определяем диапазон со значениями для замен
    With ThisWorkbook.Sheets("ReplaceList")
        ' Фразы для замены
        Set replacementsRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1))
        ' Если ячейка начинается на эти слова - не делаем замену
        Set startingWordsToIgnoreRn = Range(.Cells(2, 4), .Cells(.Rows.Count, 4).End(xlUp))
    End With
    
    With ThisWorkbook.Sheets("Specification")
        ' Устанавливаем стартовый диапазон
        Set replaceRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
        ' Выделяем стартовый диапазон
        replaceRn.Parent.Activate
        replaceRn.Select
        ' Выведем запрос на изменение диапазона
        On Error Resume Next
        Set inputRn = Application.InputBox( _
                        Prompt:="Адрес для массовой замены", _
                        Title:="Замена по списку", _
                        Default:=replaceRn.Address(True, True, xlA1, True), _
                        Type:=8)
        Err.Clear
        On Error GoTo 0
        ' Если пользователь отменил выделение - выйдем из макроса с предупреждением
        If Not inputRn Is Nothing Then
            Set replaceRn = inputRn
        Else
            MsgBox "Диапазон не выбран", vbCritical
            Exit Sub
        End If
    End With
    
    ' Для каждой пары заменяемых значений сделаем замену
    For Each rrow In replacementsRn.Rows
        ' По умолчанию - обрабытываем ячейку
        proceed = True
        ' Проверяем наличие слов из списка
        For Each wordRn In startingWordsToIgnoreRn
            word = wordRn.Value
            If Left(rrow.Cells(1, 1).Value, Len(word)) = word Then
                proceed = False
                Exit For
            End If
        Next wordRn
        
        ' Если нет слов из списка - начинаем замену.
        If proceed Then
            replaceRn.Replace What:=rrow.Cells(1, 1).Value, Replacement:=rrow.Cells(1, 2).Value
        End If
    Next rrow
    
    ' Выведем сообщение о завершении работы (можно убрать)
    MsgBox "Done!", vbInformation
End Sub

    ' Для каждой пары заменяемых значений сделаем замену
    For Each rrow In replacementsRn.Rows
        replaceRn.Replace What:=rrow.Cells(1, 1).Value, Replacement:=rrow.Cells(1, 2).Value, LookAt:=xlWhole
    Next rrow
    

Sub iterateMacroOnGivenSheets()
    sheetsToProcess = Array("Лист1", "Лист2", "Лист3")
    
    For Each aSheet In sheetsToProcess
        ThisWorkbook.Sheets(aSheet).Activate
        clean
        filter
        format
    Next aSheet
    
End Sub

F2  =ЕСЛИ(A2<>0;A2;F1)
G2  =$F2 & $C2

Application.Run "path!open_last_and_update" # проблема с кавычками

Application.Run "'" & path & "'!open_last_and_update" # проблема с кавычками

 переделывать уже не хотелось

=ПРОМЕЖУТОЧНЫЕ.ИТОГИ(102;$A6)

Sub generateShape()
    Dim ws As Worksheet, sh As Shape
    Set ws = ActiveSheet
    With ws
        shWidth = .Cells(2, 7).Value
        shHeight = .Cells(3, 7).Value
        
        Set sh = .Shapes.AddShape(msoShapeDonut, 150, 150, shWidth, shHeight)
        sh.Select
        
    End With
End Sub

newCoordsArr2 = evaluateDotMove( _
                                CInt(dotsCoordsArr2(i, 0).Value), _
                                CInt(dotsCoordsArr2(i, 1).Value), _
                                CInt(dotsCoordsArr2(i, 2)), _
                                CInt(dotsCoordsArr2(i, 3)) _
                            )

' Угол - ПОСТОЯННОЕ НАПРАВЛЕНИЕ
                        dotsCoordsArr2(i, 2) = 2

' Скорость движения - случайное значение в интервале от 5 до 15
                        dotsCoordsArr(i, 3) = 2 ' Фиксированная скорость 2 - как пример
                        'dotsCoordsArr(i, 3) = Application.RandBetween(5, 15)

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal ClassName As String, ByVal WindowName As String) As Long
    
    Private Declare Function LockWindowUpdate Lib "user32" _
        (ByVal hWndLock As Long) As Long


    Sub EliminateScreenFlicker()
        Dim VBEHwnd As Long
        
        On Error GoTo ErrH:
        
        Application.VBE.MainWindow.Visible = False
        
        VBEHwnd = FindWindow("wndclass_desked_gsk", _
            Application.VBE.MainWindow.Caption)
        
        If VBEHwnd Then
            LockWindowUpdate VBEHwnd
        End If
        
        '''''''''''''''''''''''''
        ' your code here
        '''''''''''''''''''''''''
        
        Application.VBE.MainWindow.Visible = False
    ErrH:
        LockWindowUpdate 0&
    End Sub

Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
With Application.Workbooks("1.xls").Sheets("Лист3")
  On Error Resume Next

  .[A1] = .[A1] + 1
 runDotMovementStep
...

' Массив с данными по точкам (x(range),y(range),угол, скорость движения)
Public dotsCoordsArr()
' Точки считаны
Public dotsValuesAreSetBool As Boolean

' Считываем текущие координаты точек, устанавливаем угол направления и скорость движения
Sub dotsInitialise()
    Dim coordsRn As Range
        Set coordsRn = ThisWorkbook.Sheets("Лист3").Range("C6:D26")
        ' dotsCoordsArr(i) = (i_xRn,i_yRn,i_curAngle, i_curSpeed)
        
        If dotsValuesAreSetBool = False Then
            ' Определяем границы массива
            ReDim dotsCoordsArr(0 To coordsRn.Rows.Count - 1, 0 To 3)
            ' Пробегаемся по всем строкам с данными о точках
            For i = 0 To coordsRn.Rows.Count
                With coordsRn.Rows(i + 1)
                    ' Записываем данные в массив если значение - не пустое
                    If Not (IsEmpty(.Cells(1).Value)) And Not (IsEmpty(.Cells(2).Value)) Then
                        ' i_xRn
                        Set dotsCoordsArr(i, 0) = .Cells(1)
                        ' i_yRn
                        Set dotsCoordsArr(i, 1) = .Cells(2)
                        ' Угол - случайное значение в интервале от -180 до 180
                        dotsCoordsArr(i, 2) = Application.RandBetween(-180, 180)
                        ' Скорость движения - случайное значение в интервале от 5 до 15
                        dotsCoordsArr(i, 3) = Application.RandBetween(5, 15)
                    End If
                End With
            Next i
            ' Значения считанын
            dotsValuesAreSetBool = True
        End If
End Sub

Sub runDotMovementStep()
    ' Первый запуск - заносим в массив информацию о точках и присваиваем направление со скоростью
    If dotsValuesAreSetBool = False Then dotsInitialise
    
    ' Пробегаемся по массиву данных
    For i = LBound(dotsCoordsArr, 1) To UBound(dotsCoordsArr, 1)
        ' Если X и Y - не пустые - расчитываем движение точки
        If _
            Not IsEmpty(dotsCoordsArr(i, 0)) And _
            Not IsEmpty(dotsCoordsArr(i, 1)) _
        Then
            ' Запускаем расчет (x,y,angle, speed)
            newCoordsArr = evaluateDotMove( _
                                CInt(dotsCoordsArr(i, 0).Value), _
                                CInt(dotsCoordsArr(i, 1).Value), _
                                CInt(dotsCoordsArr(i, 2)), _
                                CInt(dotsCoordsArr(i, 3)) _
                            )
            ' Записываем координаты, обновляем данные об угле и скорости(не реализовано изменение)
            dotsCoordsArr(i, 0).Value = newCoordsArr(0)
            dotsCoordsArr(i, 1).Value = newCoordsArr(1)
            dotsCoordsArr(i, 2) = newCoordsArr(2)
            dotsCoordsArr(i, 3) = newCoordsArr(3)
        End If
    Next i
    
    
    
End Sub

'  Расчет движения точки
Function evaluateDotMove( _
            x As Integer, _
            y As Integer, _
            angle As Integer, _
            speed As Integer, _
            Optional minX As Integer = 0, _
            Optional minY As Integer = 0, _
            Optional maxX As Integer = 100, _
            Optional maxY As Integer = 100 _
            ) As Variant

    newAngle = angle
    
    ' Координаты по X и Y
    newX = x + CInt((speed * Cos(angle / (180 / Application.Pi()))))
    newY = y + CInt((speed * Sin(angle / (180 / Application.Pi()))))
    
    ' Если выходим за допустимые диапазоны - расчитаем положение и угол отражения
    If newX > maxX Then
        newX = maxX - (newX - maxX)
        newAngle = angleReflect(angle, 90)
    ElseIf newX < minX Then
        newAngle = angleReflect(angle, 270)
        newX = newX * -1
    End If
    
    If newY > maxY Then
        newY = maxY - (newY - maxY)
        newAngle = angleReflect(angle, 180)
    ElseIf newY < minY Then
        newY = newY * -1
        newAngle = angleReflect(angle, 0)
    End If
    
    ' Запишем данные в возвращаемый массив
    ReDim dotMoveArr(0 To 3)
    dotMoveArr(0) = newX
    dotMoveArr(1) = newY
    dotMoveArr(2) = newAngle
    dotMoveArr(3) = speed
    
    evaluateDotMove = dotMoveArr
End Function

' http://qaru.site/questions/14049611/calculate-angle-change-after-hitting-a-tilted-wall
Function angleReflect(incidenceAngle, surfaceAngle) As Integer

    a = surfaceAngle * 2 - incidenceAngle
    If a >= 360 Then
        angleReflect = a - 360
    ElseIf a < 0 Then
        angleReflect = a + 360
    Else
        angleReflect = a
    End If
    
End Function

If iPos > 1 Then iCell.Characters(iPos + 2, 3).Font.Bold = True

=ЕСЛИОШИБКА(ВПР($C7;$L$6:$O$12;4;0);ЕСЛИОШИБКА(ВПР($C7;$P$6:$S$12;4;0);ЕСЛИОШИБКА(ВПР($C7;$T$6:$W$12;4;0);"-")))

=ЕСЛИОШИБКА(ПРОМЕЖУТОЧНЫЕ.ИТОГИ(102;$A4)*A4;0)

{=СУММ(--(СЧЁТЕСЛИ(C2:C75;A2:A75)>1))}

Sub createEmptyRows()
    ' С текущим листом
    With ActiveSheet
        ' Диапазон действия - все строки с ячейки A2 по последнюю заполненную в колонке A
        Set actionRn = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).EntireRow
        ' Диапазон с кол-вом строк для вставки
        Set rowsToCreateAmountCol = .Range("K:K")
        
        ' Для каждой строки после которй нужно вставить пустые строки (с конца к началу)
        For i = actionRn.Rows.Count To 1 Step -1
            ' В диапазон под текущей строкой
            ' вставить кол-во строк из пересечения текущей строки с колонкой K
            actionRn.Rows(i).Offset(1, 0).Resize(RowSize:=Intersect(actionRn.Rows(i), rowsToCreateAmountCol).Cells(1).Value).Insert
        Next i
    End With
End Sub

ThisWorkbook.Sheets(3).Range("A1:A150")

ThisWorkbook.Sheets("КакоетоИмяЛиста").Range("A1:A150")

Sub cellsColors()
    For Each ccell In Selection.Cells
        ccell.Value = ccell.Interior.Color
    Next ccell
End Sub