форматирование ячеек vba

[sovareal]

Возникла необходимость реализовать форматирование текста в формирующемся отчете. Сам я с vba по долгу службы фактически не знаком. Буду очень благодарен за любую помощь.

1)Убрать первую строку(шапку) и 2 последние(подпись)
2)Вместо столбцов S и T сделать один столб информация в котором будет сумой S и T.
3)Все даты формата **,**,13 привести к виду **,**,2013
4)отформатировать столб С так, чтобы вместо **1234 оставался только числовой идентификатор.

Все кроме пункта 4) с горем-пополам удалось реализовать. По идее необходимо проверить вначале есть ли символы из строки B в С и если есть удалить их из С, а потом второй проверкой удалить все оставшиеся буквы из С.

Ниже код того, что пока удалось написать и пример файла. Буду очень благодарен за помощь. Работа горит.

Sub ListFormat()
    Dim lRow&, iCell As Range, i&
    lRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 1)??????? ??????
        Cells(lRow - 1, "A").Resize(2, 1).EntireRow.Delete
    [A1].EntireRow.Delete
    
    lRow = lRow - 3
    
    ' 2)????????? ?????
       For i = 1 To lRow
        Cells(i, "S") = Cells(i, "S").Value + Cells(i, "T").Value
    Next i
    [T1].EntireColumn.Delete
    
    ' 3)?????? ??????? ?????? ??
    For i = 1 To lRow
        Cells(i, "C") = Mid(Cells(i, "C"), 3)
    Next i
    
    ' 4)?????? ???? **,**,13 ia **,**,2013
     
    
    Dim cell As Range, ra As Range: Application.ScreenUpdating = False
    Set ra = Range([m1], Range("m" & Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        txt = Replace(cell, ".13", ".2013"): pos = InStrRev(txt, ":")
        If pos Then Mid(txt, pos, 1) = ".13"
        If cell <> txt Then cell.NumberFormat = "@": cell = txt
    Next cell
    
    Set ra = Range([n1], Range("n" & Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        txt = Replace(cell, ".13", ".2013"): pos = InStrRev(txt, ":")
        If pos Then Mid(txt, pos, 1) = ".13"
        If cell <> txt Then cell.NumberFormat = "@": cell = txt
    Next cell
End Sub

[IgorGO]

это не вписывается в Ваше тех.задание

    For i = 1 To lRow
        Cells(i, "C") = Mid(Cells(i, "C"), 3)
    Next i

замените так:

  For r = 3 To lrow
    If Cells(r, 3) Like "*####" Then c = 4 Else c = 3
    Cells(r, 3) = Right(Cells(r, 3), c)
  Next

я сейчас для Азербайджанских авиалиний "рисую" графики полетов. интересно -обращайтесь.

[sovareal]

Спасибо за помощь, единственная проблема - "*" и 0 тоже, так что если номер рейса начинается с "0" то его тоже "скушает".
Можно ли как-то задать только буквенный интервал?

[IgorGO]

какие рейсы не обработались этой процедурой, дайте примеры.

[sovareal]

AUI046, AUI048(9 и 12 строка после обработки)

[IgorGO]

лидирующие нули теряются?
1) задайте колонке С формат "текстовый"
2) в примере выше используйте так:

    Cells(r, 3) = Format(Right(Cells(r, 3), c), String(c, "0"))

[sovareal]

Эффект тот-же. 0 "кушает"

[IgorGO]

1. указали формат колонке
2. выполнили макрос и это

Cells(r, 3) = Format(Right(Cells(r, 3), c), String(c, "0"))

не работает?

[sovareal]

Вот что я сделал

Sub ListFormat()
    Columns("C:C").Select
    Range("C2").Activate
    Selection.NumberFormat = "@"
    Dim lRow&, iCell As Range, i&
    lRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 1)??????? ??????
        Cells(lRow - 1, "A").Resize(2, 1).EntireRow.Delete
    [A1].EntireRow.Delete
    
    lRow = lRow - 3
    
    ' 2)????????? ?????
       For i = 1 To lRow
        Cells(i, "S") = Cells(i, "S").Value + Cells(i, "T").Value
    Next i
    [T1].EntireColumn.Delete
    
    ' 3)?????? ??????? ?????? ??
        

    For r = 3 To lRow
    If Cells(r, 3) Like "*####" Then c = 4 Else c = 3
        Cells(r, 3) = Format(Right(Cells(r, 3), c), String(c, "0"))
    Next

    
    ' 4)?????? ???? **,**,13 ia **,**,2013
     
    
    Dim cell As Range, ra As Range: Application.ScreenUpdating = False
    Set ra = Range([m1], Range("m" & Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        txt = Replace(cell, ".13", ".2013"): pos = InStrRev(txt, ":")
        If pos Then Mid(txt, pos, 1) = ".13"
        If cell <> txt Then cell.NumberFormat = "@": cell = txt
    Next cell
    
    Set ra = Range([n1], Range("n" & Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        txt = Replace(cell, ".13", ".2013"): pos = InStrRev(txt, ":")
        If pos Then Mid(txt, pos, 1) = ".13"
        If cell <> txt Then cell.NumberFormat = "@": cell = txt
    Next cell
End Sub

Извиняюсь, некорректно выразился.
Первую колонку не форматирует, а 0 оставило.

[sovareal]

Сам разобрался. Нужно было поставить обработку с 2 строки, т.к. мы первую то удаляем.

Получаем

For r = 2 To lRow
    If Cells(r, 3) Like "*####" Then c = 4 Else c = 3
        Cells(r, 3) = Format(Right(Cells(r, 3), c), String(c, "0"))
    Next