Макрос для обработки выписок Сбербанка

Sub УдалитьПустыеЯчейки()
'  i = 12 'Начальная позиция для удаления пустых строк, кторые не содержат дату в ячейке С
t = Timer

  Application.ScreenUpdating = False
  
  For i = 12 To 2900
  
      If IsDate(Range("C" & i).Value) = False Then
         Range(i & ":" & i).Delete
         i = i - 1
         ElseIf IsDate(Range("C" & i + 1).Value) = False Then
                 Range(i + 1 & ":" & i + 1).Delete
        Else: i = i + 1
      End If
      
      DoEvents
      
      If Len(Range("C" & i + 1).Value) = 0 And _
         Len(Range("C" & i + 2).Value) = 0 And _
         Len(Range("C" & i + 3).Value) = 0 And _
         Len(Range("C" & i + 4).Value) = 0 And _
         Len(Range("C" & i + 5).Value) = 0 And _
         Len(Range("C" & i + 6).Value) = 0 And _
         Len(Range("C" & i + 7).Value) = 0 And _
         Len(Range("C" & i + 8).Value) = 0 And _
         Len(Range("C" & i + 9).Value) = 0 And _
         Len(Range("C" & i + 10).Value) = 0 Then Exit For
  Next i
  
   Application.ScreenUpdating = True
   
   t = Timer - t
Range("A1") = "Затрачено времени: " & Format(t / 60, "0.00") & "мин."
Range("A1").Font.Color = vbRed
Range("A1").Font.Bold = True
Range("A1").Font.Size = 14
Range("A1").WrapText = False
End Sub


Sub dddddd()

For i = 11 To 1700
'Debug.Print Right(Range("B200"), Len(Range("B200")) - Len("40702810438250132520 77226100000"))
'On Error Resume Next
Range("H" & i) = Right(Range("H" & i), Len(Range("H" & i)) - Len("40702810438250132520 77226100000"))

Next i
End Sub


Public Sub ПреобразоватьТекстВЧисло()
    Dim r As Range
    With ActiveSheet
        Set r = Intersect(.UsedRange, .[L:S]).Offset(1)
        r.FormulaLocal = r.FormulaLocal
    End With
End Sub


Function delcr2000(ByVal r As Range)
Dim arr() As String
ReDim arr(200)
For i = 1 To Len(r)
  arr(i) = Mid(r, i, 1)
  If Mid(r, i, 1) = "/" Then
     arr(i) = " "
     sssss = 1
     Exit For
  End If
Next i
delcr2000 = Left(Join(arr(), ""), Len(Join(arr(), "")) - 2)

If sssss  1 Then delcr2000 = r
End Function


Sub dsdsdsdsdsdsddsd()
  
  For Each r In Range("i2:i1050")
      r = delcr2000(r)
  Next


End Sub

'--------------------------------------------------------------------------------------------
'Функция осуществляет поиск в массиве Rng значения, которые содержатся в массиве RngFind
'Если значение найдено (по маске), то возвращает найденное значение, если нет, то пустую строку.
'--------------------------------------------------------------------------------------------
Function GetNameInRng(ByVal Rng As Range, RngFind As Range)

On Error GoTo Next_

For Each r In Rng
   For Each r0 In RngFind

    If Not r.Find(r0.Value) Is Nothing Then
        GetNameInRng = r0.Value
    End If
    
    Next
Next
Next_:
End Function

'Функция возвращает дату, приведенную к формату ГГГГ.ММ.01
Function GenMyDate(ByVal Rng As Date)
    If IsDate(Rng) Then
         Rng = Format(Rng, "YYYY.MM.01")
         GenMyDate = Rng
    Else: GenMyDate = ""
    End If
End Function


'Процедура для пакетного преобразования даты в выделенной области
Sub ConvertDate()
 Set Rng = Application.InputBox( _
            Prompt:=Prompt, _
            Title:="Введите адреса ячеек для преобразования даты:", _
            Default:=ActiveCell.Address, _
            Type:=8)
            
      For Each r In Rng
          rr = r
          r.Value = GenMyDate(rr)
      Next
End Sub