Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Помогите упростить макрос
 
' вставка колонки  
   Columns("E:E").Select  
   Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove  
 
       Dim iLastRow As Long, rG As Range, cc As Range  
       iLastRow = Range("B" & Rows.Count).End(xlUp).Row  
       Set rG = Range("E2:E" & iLastRow)  
       rG.FormulaR1C1 = "=RC[2]&IF(RC[8]="""","""","" / ""&RC[8])"
       'чтобы выделить текст курсивом, надо формулы преобразовать в текст  
       rG.Copy  
       rG.PasteSpecial xlPasteValues  
       'применение курсива  
       For Each cc In rG.Cells  
       cc.Characters(Len(cc.Offset(0, 2)) + 4, Len(cc.Offset(0, 8))).Font.Italic = True  
       Next  
 
' смена формата на дату  
   Range("B:B,J:J,L:L").Select  
   Selection.NumberFormat = "dd/mm/yy;@"  
   Selection.ColumnWidth = 8  
     
   Range("B1").Select  
   ActiveCell.FormulaR1C1 = "Дата отпр."  
   Range("D1").Select  
   ActiveCell.FormulaR1C1 = "Получ."  
   Range("E1").Select  
   ActiveCell.FormulaR1C1 = "Отправитель"  
   Range("F1").Select  
   ActiveCell.FormulaR1C1 = "ФИО"  
   Range("L1").Select  
   ActiveCell.FormulaR1C1 = "Контр."  
   Range("H1").Select  
   ActiveCell.FormulaR1C1 = "Исполн."  
   Range("K1").Select  
   ActiveCell.FormulaR1C1 = "Сост-ие"  
     
   Columns("A:A").ColumnWidth = 8.5  
   Columns("H:H").ColumnWidth = 12  
   Columns("K:K").ColumnWidth = 9  
   Columns("C:C").ColumnWidth = 20  
   Columns("D:D").ColumnWidth = 10.71  
   Columns("E:E").ColumnWidth = 30  
 
' делаем шрифт поменьше там, где он не особо нужен  
   Range("H:H,D:D,K:K").Select  
  With Selection.Font  
       .Name = "Calibri"  
       .Size = 9  
   End With  
     
'прячем необходимые столбцы  
Union([G1], [M1]).EntireColumn.Hidden = True
     
' выделяем участок для задания границ  
Range("A1:L" & ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Select  
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone  
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone  
           With Selection.Borders(xlEdgeLeft)  
               .LineStyle = xlContinuous  
               .ColorIndex = xlAutomatic  
               .Weight = xlThin  
           End With  
           With Selection.Borders(xlEdgeTop)  
               .LineStyle = xlContinuous  
               .ColorIndex = xlAutomatic  
               .Weight = xlThin  
           End With  
           With Selection.Borders(xlEdgeBottom)  
               .LineStyle = xlContinuous  
               .ColorIndex = xlAutomatic  
               .Weight = xlThin  
           End With  
           With Selection.Borders(xlEdgeRight)  
               .LineStyle = xlContinuous  
               .ColorIndex = xlAutomatic  
               .Weight = xlThin  
           End With  
           With Selection.Borders(xlInsideVertical)  
               .LineStyle = xlContinuous  
               .ColorIndex = xlAutomatic  
               .Weight = xlThin  
           End With  
           With Selection.Borders(xlInsideHorizontal)  
               .LineStyle = xlContinuous  
               .ColorIndex = xlAutomatic  
               .Weight = xlThin  
           End With  
           With Selection  
               .HorizontalAlignment = xlGeneral  
               .VerticalAlignment = xlTop  
               .AddIndent = False  
               .ShrinkToFit = False  
               .ReadingOrder = xlContext  
           End With  
             
             
 Union([C1], [E1], [F1], [H1], [I1]).EntireColumn.WrapText = True
 ' Union([I1]).EntireColumn.ShrinkToFit = True
 '          With Selection  
 '              .WrapText = True  
 '          End With  
 
' делаем границы печати поменьше, лист делаем горизонтальным  
   With ActiveSheet.PageSetup  
       .LeftMargin = Application.InchesToPoints(0.15748031496063)  
       .RightMargin = Application.InchesToPoints(0.15748031496063)  
       .TopMargin = Application.InchesToPoints(0.15748031496063)  
       .BottomMargin = Application.InchesToPoints(0.15748031496063)  
       .HeaderMargin = Application.InchesToPoints(0)  
       .FooterMargin = Application.InchesToPoints(0)  
       .Orientation = xlLandscape  
' это чтобы заголовой на всех страницах печатался  
       .PrintTitleRows = "$1:$1"  
       .PrintTitleColumns = ""  
   End With  
 
' форматирование шапки  
   Rows("1:1").Select  
   With Selection  
       .HorizontalAlignment = xlCenter  
       .VerticalAlignment = xlCenter  
       .ShrinkToFit = True  
       .ReadingOrder = xlContext  
   End With  
   ' красим фон шапки  
   With Selection.Interior  
       .Pattern = xlSolid  
       .PatternColorIndex = xlAutomatic  
       .ThemeColor = xlThemeColorDark1  
       .TintAndShade = -0.349986266670736  
 
   End With  
   With Selection.Font  
       .Name = "Calibri"  
       .FontStyle = "полужирный"  
       .Size = 11  
       .Underline = xlUnderlineStyleNone  
       .ThemeColor = xlThemeColorLight1  
       .ThemeFont = xlThemeFontMinor  
   End With  
 
End Sub
Склеивание текста (CONCATENATE) надо применить к области непонятного размера
 
Требуется вот что.  
1. Создать новую колонку (тут проблем нет)  
2. Спрятать две "старые" (тоже не проблема)  
3. Склеить текст из двух старых  
4. Между склейкой пустить какой-то визуальный разделитель, а лучше второй текст сделать курсивом  
 
Проблема в том, что я не знаю заранее количество строк в колонках.  
 
Выходит что-то типа  
  Range("G:G").Select  
   ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[4],"" / "",RC[6])"
   Selection.AutoFill Destination:=Range("G2:G115"), Type:=xlFillDefault  
 
, где G-это новосозданная колонка. Две старые колонки находятся соответственно на 4 и 6 позициях правее.  
Увы, не могу правильно задать этот самый G2:G115
Страницы: 1
Наверх