Добрый день! Никак не получается прописать макрос. необходимо, чтобы он работал на любом количестве листов и с любым количеством ячеек, в которых есть информация. Нужно, чтобы был определенный формат: 1. Шрифт "Arial" 2.Размер 12 3.Выравнивание справа 4.Не должно быть границ 5. Не должно быть гиперссылок и чтобы макрос создавал рядом с столбцом "Дата" столбец "Возраст" и считал его формулой...
Добрый день! Никак не получается прописать макрос. необходимо, чтобы он работал на любом количестве листов и с любым количеством ячеек, в которых есть информация. Нужно, чтобы был определенный формат: 1. Шрифт "Arial" 2.Размер 12 3.Выравнивание справа 4.Не должно быть границ 5. Не должно быть гиперссылок и чтобы макрос создавал рядом с столбцом "Дата" столбец "Возраст" и считал его формулой...kotenok-vamp
Sub Macros() With Selection.Font .Name = "Arial" .Size = 12 .Color = vbblack End With With Selection .Borders.LineStyle = False .HorizontalAlignment = xlVAlignLeft End With
End Sub
[/vba]
Но эта зараза не хочет работать и не выдает даже где ошибка((( И не получается, чтобы убирал гиперссылки, вставлял столбец и работал на всех листах
упс, пардон. Вот макрос: [vba]
Код
Sub Macros() With Selection.Font .Name = "Arial" .Size = 12 .Color = vbblack End With With Selection .Borders.LineStyle = False .HorizontalAlignment = xlVAlignLeft End With
End Sub
[/vba]
Но эта зараза не хочет работать и не выдает даже где ошибка((( И не получается, чтобы убирал гиперссылки, вставлял столбец и работал на всех листахkotenok-vamp
Сообщение отредактировал kotenok-vamp - Вторник, 27.04.2021, 11:42
Sub Test() Dim Sht As Worksheet Dim FoundData As Range Dim FoundPochta As Range Dim i As Long Dim iLR As Long Dim hl As Hyperlink For Each Sht In Worksheets With Sht Set FoundData = .Rows(1).Find("Дата", , xlValues, xlWhole) .Columns(FoundData.Column + 1).Insert .Cells(1, FoundData.Column + 1) = "Возраст" iLR = .Cells(.Rows.Count, 1).End(xlUp).Row For i = 2 To iLR .Cells(i, FoundData.Column + 1) = Year(Date) - Year(.Cells(i, FoundData.Column)) .Cells(i, FoundData.Column + 1).NumberFormat = "@" Next Set FoundPochta = .Rows(1).Find("почта", , xlValues, xlWhole) If Not FoundPochta Is Nothing Then For Each hl In .Range(.Cells(2, FoundPochta.Column), .Cells(iLR, FoundPochta.Column)).Hyperlinks If hl.Type = 0 Then hl.Delete End If Next End If With .UsedRange.Font .Name = "Arial" .Size = 12 End With With .UsedRange .HorizontalAlignment = xlRight .Borders.LineStyle = xlNone End With End With Next End Sub
[/vba]
Попробуйте макрос (в стандартный модуль) [vba]
Код
Sub Test() Dim Sht As Worksheet Dim FoundData As Range Dim FoundPochta As Range Dim i As Long Dim iLR As Long Dim hl As Hyperlink For Each Sht In Worksheets With Sht Set FoundData = .Rows(1).Find("Дата", , xlValues, xlWhole) .Columns(FoundData.Column + 1).Insert .Cells(1, FoundData.Column + 1) = "Возраст" iLR = .Cells(.Rows.Count, 1).End(xlUp).Row For i = 2 To iLR .Cells(i, FoundData.Column + 1) = Year(Date) - Year(.Cells(i, FoundData.Column)) .Cells(i, FoundData.Column + 1).NumberFormat = "@" Next Set FoundPochta = .Rows(1).Find("почта", , xlValues, xlWhole) If Not FoundPochta Is Nothing Then For Each hl In .Range(.Cells(2, FoundPochta.Column), .Cells(iLR, FoundPochta.Column)).Hyperlinks If hl.Type = 0 Then hl.Delete End If Next End If With .UsedRange.Font .Name = "Arial" .Size = 12 End With With .UsedRange .HorizontalAlignment = xlRight .Borders.LineStyle = xlNone End With End With Next End Sub