Улыбайся чаще!

Убрать второй символ с конца ячейки

Вставить как формулу в СЛЕДУЮЩИЙ столбец

=СЦЕПИТЬ(ЛЕВСИМВ(RC[-1]; ДЛСТР(RC[-1])-2);ПРАВСИМВ(RC[-1];1))
=СЦЕПИТЬ(ЛЕВСИМВ(C1; ДЛСТР(C1)-2);ПРАВСИМВ(C1;1))

Конвертер годов

Тестовая табличка с годами (месяц двумя цифрами, месяц/год, начало-конец:

         
Было:         Стало:  
02            2002
98-99         1998,1999
12/10         2010
09/03-12/06   2003,2004,2005,2006
91-03/93      1991,1992,1993
02/99-01      1999,2000,2001
97            1997

Внимание! Необходимо выбрать формат ячеек как "текстовые" (правая мышка→формат→Число→Текстовый) если вместо годов вставляется какой-то мусор

Форматирование годов для Excel 2003

запускаем Excel открываем в нём табличку (или пишем свою на пробу)
нажимаем Alt+F11 (Сервис→Макрос→Редактор Visual Basic)
в появившемся окне нажимаем Insert→Module. Вставляем в окошко текст (начиная со слов Sub ConvertYears()), нажимаем Ctrs+s (File→save) [сохраняем]
нажимаем Alt+F8 (Сервис→Макрос→Макросы) щёлкаем один раз на ConvertYears
жмём кнопочку "Параметры", в окошке набираем маленькую буковку m (получится Ctrl+m), нажимаем OK, закрываем окошко макросов
выделяем ячейки с годами и жмём Ctrl+m

Форматирование годов для Excel 2007

Запускаем Excel открываем в нём табличку (или пишем свою на пробу)
Добавляем панель "Разработчик" на ленту: ссылка на Microsoft
- Нажимаем значок Кнопка Microsoft Office
- В категории Личная настройка в группе Основные параметры работы с Excel установите флажок Показывать вкладку "Разработчик" на ленте, а затем нажмите кнопку ОК.
- На вкладке Разработчик в группе Код нажмите кнопку Безопасность макросов.
- В группе Параметры макросов выберите переключатель Включить все макросы, а затем дважды нажмите кнопку ОК.
В меню Insert выберите команду Module.
В окне программы модуля скопировать текст от слова Sub до слова Sub снизу страницы, нажать кнопку Ctrl+s и закрываем это окно
Выделяем ячейки с годами
Вид→Макрос→ щёлкаем один раз на ConvertYears

copyBrand

Добавить 2 столбца слева. Выделить ячейки с D5 до E5887. Запустить

fillMark

Выделяем E36:F46, вызываем Alt+F8→fillMark. Суть процесса: как только нашлась F-ячейка "Передняя", обе ячейки заполняются одинаковым непустым значением либо "передняя, задняя" если обе ячейки были непустыми.

Sub ConvertYears()
If TypeName(Selection) <> "Range" Then Exit Sub
Dim text As String
Dim rCell As Range

With Selection
 For Each rCell In .Cells
  text = convertYear(rCell.text)
  If text = rCell.text Or text = "" Then
   rCell.Interior.Color = RGB(255 - err, 0, 0)
  Else
   rCell.Value = text
  End If
 Next rCell
End With
End Sub

Function convertYear(text As String) As String
Dim sMergeStr, stmp, srem As String


Dim l, r, err As Integer
   
Dim a, b, c As String

If Len(text) > 1 Then
  sMergeStr = ""
  err = 0
  srem = text
  
  If (Len(srem) > 2) Then
   a = Left(srem, 1)
   b = Right(Left(srem, 2), 1)
   c = Right(Left(srem, 3), 1)
   
   If b = "/" Then srem = Right(srem, Len(srem) - 2)
   If c = "/" Then srem = Right(srem, Len(srem) - 3)
  End If 'len > 2
  
  If Len(srem) = 2 Then
    l = srem
    r = srem
  Else:
   If Len(srem) < 2 Then
    err = err + 50
   Else:
    l = Left(srem, 2)
    srem = Right(srem, Len(srem) - 3)
    
    If Len(srem) > 2 Then
     a = Left(srem, 1)
     b = Right(Left(srem, 2), 1)
     c = Right(Left(srem, 3), 1)
   
     If b = "/" Then srem = Right(srem, Len(srem) - 2)
     If c = "/" Then srem = Right(srem, Len(srem) - 3)
    End If 'Len(srem) > 2
      
    If Len(srem) = 2 Then r = srem Else err = err + 50
    End If ' Len(srem) = 2
   End If ' Len(rem) < 2
  End If ' Len(srem) = 2
  
  If (IsNumeric(l) And IsNumeric(r)) Then
   If l > 60 Then l = l + 1900 Else l = l + 2000
   If r > 60 Then r = r + 1900 Else r = r + 2000
   If r >= l Then
    For i = l To r
     If i = l Then sMergeStr = i Else sMergeStr = sMergeStr & "," & i
    Next i
   Else: err = err + 50 'r>=l
  End If 'IsNumeric(l) And IsNumeric(r)
  
  If err > 0 Then convertYear = text Else convertYear = sMergeStr
End If
End Function

Sub FillGaps()

Dim rCell As Range
Dim old As String
old = ""
With Selection
 For Each rCell In .Cells
  If rCell.text = "" Then
    rCellValue = old
  Else: old = rCell.text
  End If
  rCell.Value = old
 Next rCell
End With
End Sub

Sub copyBrand()
    Const ci_gray40 = 48
    Const ci_gray25 = 15
    Const ci_gray50 = 16
    Const ci_none = -4142
    Const ci_white = 2
    Const ci_black = 1
    Dim firstRow As Integer
    Dim lastRow As Integer
    Dim firstCol As Integer
    Dim lastCol As Integer
    
    Dim cfontSize As Integer
    
    Dim oldBrand As String
    Dim oldModel As String
    Dim skipAction As Boolean
    
    Dim oldYear As String
    Dim oldEngine As String
    
    firstRow = Selection.Row
    firstCol = Selection.Column
    lastRow = Selection.Row + Selection.Rows.Count - 1
    lastCol = Selection.Column + Selection.Columns.Count - 1
    
    For j = firstRow To lastRow
     skipAction = False
     cfontSize = Cells(j, firstCol).Font.Size
     'If Cells(j, firstCol).Interior.ColorIndex = ci_black Then
     If cfontSize = 10 And Not IsEmpty(Cells(j, firstCol)) Then
      ' got 10pt Font: Car brand
      oldBrand = Cells(j, firstCol).text
      skipAction = True
     End If
     
     If cfontSize = 8 And Not IsEmpty(Cells(j, firstCol)) Then
      ' got 8pt Font: Car model
      oldModel = Cells(j, firstCol).text
      oldYear = ""
      oldEngine = ""
      skipAction = True
     End If
     
     If (cfontSize = 6 Or cfontSize = 6.5 Or IsEmpty(Cells(j, firstCol))) And skipAction = False Then
      ' got 6..6.5pt Font: target string
      If IsEmpty(Cells(j, firstCol)) Then Cells(j, firstCol).Font.Size = 6
      If Not Cells(j, firstCol) = "" Then oldYear = Cells(j, firstCol).text
      
      If Not Cells(j, firstCol + 1).text = "" Then oldEngine = Cells(j, firstCol + 1).text
      Cells(j, firstCol + 1).Value = oldEngine
      Cells(j, firstCol).Value = convertYear(oldYear)
      Cells(j, firstCol - 2).Value = oldBrand
      Cells(j, firstCol - 1).Value = oldModel
     End If
     
     
    Next j
    
    
End Sub

Sub fillMark()
    Dim firstRow As Integer
    Dim lastRow As Integer
    Dim firstCol As Integer
    Dim lastCol As Integer
    
    Dim oldBrand As String
    Dim oldModel As String
    Dim skipAction As Boolean
    
    firstRow = Selection.Row
    firstCol = Selection.Column
    lastRow = Selection.Row + Selection.Rows.Count - 1
    lastCol = Selection.Column + Selection.Columns.Count - 1
    
    For j = firstRow To lastRow
     skipAction = False
     If Cells(j, lastCol).Value <> "Передняя" Then
        skipAction = True
     End If
     If skipAction = False Then
        If Cells(j + 1, firstCol).Value <> "" Then
          Cells(j, firstCol).Value = Cells(j, firstCol).Value + ", " + Cells(j + 1, firstCol).Value
        End If
        Cells(j + 1, firstCol).Value = Cells(j, firstCol).Value
     End If
     
    Next j
    
End Sub