If Not Intersect(Target, Range("F" & lLastRow)) Is Nothing Then Exit Sub

Sub Color_RUS_LAT()   ' Выделяет русские символы в Selection ЗЕЛЁНЫМ, латинские - КРАСНЫМ
   If TypeName(Selection) <> "Range" Then Exit Sub
   With ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants).SpecialCells(xlCellTypeVisible)
      If Intersect(Selection, .Cells) Is Nothing Then Exit Sub
      Intersect(Selection, .Cells).Select
   End With
   Dim rCell As Range, i&
   With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: End With
   For Each rCell In Selection
      For i = 1 To Len(rCell)
         If Mid$(rCell, i, 1) Like "[А-Яа-яЁё]" Then rCell.Characters(i, 1).Font.Color = vbGreen
         If Mid$(rCell, i, 1) Like "[A-Za-z]" Then rCell.Characters(i, 1).Font.Color = vbRed
      Next i
   Next rCell
   With Application: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlAutomatic: End With
End Sub

Private Sub Repair_RUS()   ' заменить латинские буквы такими же по начертанию русскими
   With ActiveSheet.UsedRange
      If Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub
      Application.ScreenUpdating = False: Application.EnableEvents = False
      Dim LATChr$: LATChr = "CcEeTOopPAaHKkXxBM"
      Dim RUSChr$: RUSChr = "СсЕеТОорРАаНКкХхВМ"
      Dim i%
      For i = 1 To Len(LATChr)
         Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)).Replace _
               What:=Mid(LATChr, i, 1), Replacement:=Mid(RUSChr, i, 1), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
      Next i
   End With
   Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

Private Sub Repair_LAT()   ' заменить русские буквы такими же по начертанию латинскими
   With ActiveSheet.UsedRange
      If Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)) Is Nothing Then Exit Sub
      Application.ScreenUpdating = False: Application.EnableEvents = False
      Dim arrENG: arrENG = Split("C c E e T O o p P A a H K k X x B M")
      Dim arrRUS: arrRUS = Split("С с Е е Т О о р Р А а Н К к Х х В М")
      Dim i%
      For i = 0 To UBound(arrENG)
         Intersect(ActiveWindow.RangeSelection, .SpecialCells(xlCellTypeVisible), .SpecialCells(xlCellTypeConstants)).Replace _
               What:=arrRUS(i), Replacement:=arrENG(i), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
      Next i
   End With
   Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

Sub Draws_0D_Select()   ' выделить НА ЛИСТЕ все рисунки с нулевыми размерами
   Dim oDraw As Shape
   If ActiveSheet.DrawingObjects.Count = 0 Then:   MsgBox "В выделенном диапазоне нет рисунков", , "Нет объектов!": Exit Sub
   For Each oDraw In ActiveSheet.DrawingObjects.ShapeRange
      If oDraw.Width = 0 Or oDraw.Height = 0 Then oDraw.Select (False)
   Next
End Sub

On Error Resume Next

ActiveWindow.RangeSelection.SpecialCells(xlCellTypeConstants).Select

   With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: End With
   …
   With Application: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlAutomatic: End With

rArea.FormulaLocal = rArea.FormulaLocal

Sub Repair_Value()   ' в выделенных ячейках исправить экспортированные как текст данные чтобы нормально опознались числа
   Dim rArea As Range
   On Error Resume Next
   ActiveWindow.RangeSelection.SpecialCells(xlCellTypeConstants).Select
   If Err Then Exit Sub
   With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: End With
   For Each rArea In Selection.Areas
      rArea.FormulaLocal = rArea.FormulaLocal
   Next rArea
   With Application: .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlAutomatic: End With
End Sub

Function ИЗВЛЕЧЬ_ЦЕЛЫЕ(ParamArray ДИАПАЗОН())
'---------------------------------------------------------------------------------------
' Author       : Alex_ST, v__step, nerv
' URL          : http://www.excelworld.ru/forum/3-1012-97065-16-1401961860
' Topic        : Функция (UDF) "ИЗВЛЕЧЬЦЕЛЫЕ"
' Purpose      : Создать массив из целых чисел, извлечённых из текста произвольно расположенных ячеек
' Notes        : К полученному массиву-результату можно применять любые стандартные формулы листа
'---------------------------------------------------------------------------------------
   Dim rArea, rCell, sStr$, oMatches, i&, Arr()
   On Error GoTo xlErrEXIT
   For Each rArea In ДИАПАЗОН
      For Each rCell In IIf(rArea.Count = 1, Array(rArea.Value), rArea.Value)
         sStr = sStr & " " & rCell
      Next rCell
   Next rArea
   With CreateObject("VBScript.RegExp"): .Global = True: .Pattern = "\d+": Set oMatches = .Execute(sStr): End With
   If oMatches.Count = 0 Then ИЗВЛЕЧЬ_ЦЕЛЫЕ = CVErr(xlErrNA): Exit Function      ' вернуть ошибку #Н/Д если чисел нет
   '   If oMatches Is Nothing Then ИЗВЛЕЧЬ_ЦЕЛЫЕ = CVErr(xlErrNA): Exit Function   ' вернуть ошибку #Н/Д если чисел нет
   ReDim Arr(1 To oMatches.Count)
   For i = 0 To oMatches.Count - 1: Arr(i + 1) = CLng(oMatches(i).Value): Next i
   ИЗВЛЕЧЬ_ЦЕЛЫЕ = Arr
xlErrEXIT:    If Err Then ИЗВЛЕЧЬ_ЦЕЛЫЕ = CVErr(xlErrValue)   ' вернуть ошибку #ЗНАЧ! если была ошибка
End Function

Private Function FileIsBusy(File$) As Boolean   ' не открывая файла проверяет, открыт ли он вообще кем-либо
   Dim FN%: FN = FreeFile
   On Error Resume Next
   Open File For Random Access Write Lock Write As #FN
   Close #FN
   FileIsBusy = (Err <> 0)
End Function

Private Sub test_FileIsBusy()
Debug.Print FileIsBusy("C:\Temp\Hotkeys.xls")
End Sub
'-------------------------------------------------
Private Sub test_Статус_Книги()
'Свойство UserStatus возвращает 2D-массив (1, 1 to 3), содержащий информацию:
'UserStatus(1,1) - имя пользователя, открывшего книгу в режиме общего доступа,
'UserStatus(1,2) - дата и время, когда этот пользователь открыл книгу,
'UserStatus(1,3) - режим открытия книги (1 - монопольный доступ, 2 - общий доступ).
Debug.Print IIf(ThisWorkbook.UserStatus(1, 3) = 1, "Exclusive", "Shared")
End Sub