=СМЕЩ(Таблица1[[#Заголовки];[Сотрудник]]; 3; 0)

For t = 1 To rowNum

For t = 1 To rowNum - 1

Option Explicit

Const file1 = "Файл 1.xls"

Sub Кнопка1_Щелчок()
    
    ' Ссылка на столбец с цифрами
    Dim file2Cell As Range
    Dim curNo As Long
    
    ' Первый файл - активный лист
    Dim file1Sheet As Worksheet
    Set file1Sheet = Application.Workbooks(file1).ActiveSheet
    
    ' Дата, вставляемая при выполнении условий
    Dim dat As Date
    dat = file1Sheet.Range("AF6").Value
    
    For Each file2Cell In Range("D:D").Cells
        
        ' Если попалась пустая строка, то прерываемся
        If file2Cell.Value = "" Then
            Exit For
        End If
        
        ' Извлекаем число, начиная со второго символа
        curNo = Val(Mid(file2Cell.Value, 2))
        
        ' Ищем строчку с этим числом в файле 1
        If Not file1Sheet.Range("E:E").Find(curNo, , xlValues, xlWhole) Is Nothing Then
            ' Если нашли, записываем дату
            file2Cell.Offset(0, -1).Value = dat
        End If
        
    Next file2Cell
    
End Sub

Public Function Williams(srcRange As Range) As Variant

    ' Функция для пользователя Williams от Артёма Хоменко с форума http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=78037&TITLE_SEO=78037-nayti-minimalnyy-period-dlya-kotorogo-verno-uslovie&MID=652872
    ' В качестве аргумента должен быть передан один столбец
    '
     
    ' Если в переданный диапазон попадут нечисловые данные, просто пропускаем их.
    On Error Resume Next
    
    ' Количество элементов
    Dim rowNum As Long, i As Long, j As Long, t As Long
    rowNum = srcRange.Rows.CountLarge
    
    ' Создадим вектор под исходные данные и под максимумы
    Dim arrSrc() As Variant, arrMax() As Double
    ReDim arrMax(1 To rowNum)
     
    ' Скопируем в массив данные для оптимизации, чтобы не обращаться к ячейкам.
    arrSrc = srcRange.Columns(1).Value

    ' Начинаем с периода в 1 и до максимального
    For t = 1 To rowNum
        
        ' Перебираем элементы с первого и до конца
        For i = 1 To rowNum - t + 1
            
            ' Начальное значение
            arrMax(i) = arrSrc(i, 1)

            ' Перебираем элементы внутри периода - ищем максимум
            For j = 1 To t - 1
                If arrMax(i) < arrSrc(i + j, 1) Then
                    arrMax(i) = arrSrc(i + j, 1)
                End If
            Next j
            
            ' Если очередной максимум меньше предыдущего, продолжать нет смысла.
            If i > 1 Then
                If arrMax(i) > arrMax(i - 1) Then
                    GoTo next_t
                End If
            End If
            
        Next i
        
        ' Если попали сюда, то значит перебрали все максимумы и все они убывают - бинго
        Williams = t
        Exit Function
        
next_t:
    Next t
    
    ' Ничего не нашли
    Williams = CVErr(xlErrNA)
End Function

=Williams(Таблица2[Data])

Dim flag As Boolean

Sub Main()

    If flag Then
        Del_B
        flag = False
    Else
        Del_B1
        flag = True
    End If
End Sub

=ВПР($A4; ДВССЫЛ("'[Файл с данными.xlsx]" & B$2 & "'!$1:$1048576");5;ЛОЖЬ)

=ЕСЛИОШИБКА(ВПР(B3; товары!$B:$C;2;ЛОЖЬ); 0)

Sub Кнопка1_Щелчок()
    
    Dim cell As Range
    Dim winHttpReq As Object
    Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    On Error GoTo l_error
        
    For Each cell In Range("Таблица1").Columns(1).Cells
        
        cell.Offset(0, 1).Value = "Неверный адрес"
        Call winHttpReq.Open("GET", cell.Value, False)
        
        Call winHttpReq.Send
        If winHttpReq.Status = 200 Then
            cell.Offset(0, 1).Value = "Всё ок"
        Else
            cell.Offset(0, 1).Value = "Неверный запрос"
        End If
        
l_error:

    Next cell
End Sub

Option Explicit

Sub Кнопка1_Щелчок()
While True
Wend
End Sub