Sub qwer()
Dim lr As Long

lr = Cells(Rows.Count, 2).End(xlUp).Row

  Range("L3:L" & lr).NumberFormat = "m/d/yyyy"
  Range("L3:L" & lr).Replace what:=" ", replacement:=""
    Range("L3:L" & lr).Replace what:=".", replacement:=","
      Range("L3:L" & lr).Replace what:=",", replacement:="/"
        Range("L3:L" & lr).Value = Range("L3:L" & lr).Value
 
 Range("J3:J" & lr).NumberFormat = "m/d/yyyy"
  Range("J3:J" & lr).Replace what:=" ", replacement:=""
    Range("J3:J" & lr).Replace what:=".", replacement:=","
     Range("J3:J" & lr).Replace what:=",", replacement:="/"
      Range("J3:J" & lr).Value = Range("J3:J" & lr).Value
End Sub

Sub qwer()
Dim i As Long, lr As Long

lr = Cells(Rows.Count, 6).End(xlUp).Row
Range("F5:F" & lr).Replace what:=" ", replacement:=""
Range("F5:F" & lr).Replace what:=".", replacement:=","

End Sub

Range("I3:I" & lr).Replace What:=" ", Replacement:=""

Sub ReplOne()
Dim lr As Long

lr = Cells(Rows.Count, "B").End(xlUp).Row

Range("I3:I" & lr).Replace what:=".", replacement:=","

End Sub

Sub RemoveDuplicatesByTwoCriteria()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
    Dim countDict As Object
    Dim key As String

    ' Укажите лист для работы
    Set ws = ThisWorkbook.Sheets(1) ' Измените номер или имя листа при необходимости
    
    ' Найти последнюю заполненную строку в столбце B
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' Создаем объект для хранения уникальных сочетаний
    Set countDict = CreateObject("Scripting.Dictionary")
    
    ' Проходимся по строкам и подсчитываем сочетания столбцов B и E
    For i = 3 To lastRow
        key = ws.Cells(i, "B").Value & "|" & ws.Cells(i, "E").Value
        If Not countDict.exists(key) Then
            countDict.Add key, 1
        Else
            countDict(key) = countDict(key) + 1
        End If
    Next i
    
    ' Удаляем строки с повторениями больше одного
    For i = lastRow To 3 Step -1
        key = ws.Cells(i, "B").Value & "|" & ws.Cells(i, "E").Value
        If countDict(key) > 1 Then
            ws.Rows(i).Delete
            countDict(key) = countDict(key) - 1
        End If
    Next i
    
    ' Очистка памяти
    Set countDict = Nothing
    
    MsgBox "Удаление завершено!"
End Sub