Sub Макрос12()
' Макрос12 Макрос
Sheets("Словарь").Select
' удаление строк
Dim ra As Range, delra As Range
Application.ScreenUpdating = False ' отключаем обновление экрана
' ищем и удаляем строки, содержащие заданный текст
' (можно указать сколько угодно значений, и использовать подстановочные знаки)
УдалятьСтрокиСТекстом = Array("на", "для", "идти", "если", "при", "это", "до", "о", "из", "надо", "за", "в", "с", "как", "какой", "к", "что", "по", "где")
' перебираем все строки в используемом диапазоне листа
For Each ra In ActiveSheet.UsedRange.Rows
' перебираем все фразы в массиве
For Each word In УдалятьСтрокиСТекстом
' если в очередной строке листа найден искомый текст
If Not ra.Find(word, , xlValues, xlWhole) Is Nothing Then
' добавляем строку в диапазон для удаления
If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
End If
Next word
Next
' если подходящие строки найдены, то: (оставьте одну из 2 следующих строк)
' скрываем их If Not delra Is Nothing Then delra.EntireRow.Hidden = True
If Not delra Is Nothing Then delra.EntireRow.Delete ' удаляем их
' удаление строк конец
' применение форматирование
Columns("A:A").Select
Selection.FormatConditions.AddColorScale ColorScaleType:=3
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueLowestValue
With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.Color = 8109667
.TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
xlConditionValuePercentile
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
.Color = 8711167
.TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
xlConditionValueHighestValue
With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
.Color = 7039480
.TintAndShade = 0
End With
Columns("A:A").Select
Selection.FormatConditions.AddDatabar
Selection.FormatConditions(Selection.FormatConditions.Count).ShowValue = True
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.MinPoint.Modify newtype:=xlConditionValueAutomaticMin
.MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
End With
With Selection.FormatConditions(1).BarColor
.Color = 15698432
.TintAndShade = 0
End With
Selection.FormatConditions(1).BarFillType = xlDataBarFillSolid
Selection.FormatConditions(1).Direction = xlContext
Selection.FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
Selection.FormatConditions(1).BarBorder.Type = xlDataBarBorderNone
Selection.FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
With Selection.FormatConditions(1).AxisColor
.Color = 0
.TintAndShade = 0
End With
With Selection.FormatConditions(1).NegativeBarFormat.Color
.Color = 255
.TintAndShade = 0
End With
' применение форматирование конец
' добавление графика
Range("A1:B1").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlBarOfPie
ActiveChart.SetSourceData Source:=Range("Словарь!$A$1:$B$1")
ActiveChart.SeriesCollection(1).Values = "=Словарь!$A$2:$A$20"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=Словарь!$B$1"
ActiveChart.SeriesCollection(2).Values = "=Словарь!$B$2:$B$20"
ActiveChart.SeriesCollection(2).XValues = "=Словарь!$B$2:$B$20"
ActiveChart.ChartTitle.Select
ActiveChart.ApplyLayout (6)
ActiveChart.ChartTitle.Text = "ТОП20 униграмм в семантическом ядре"
Selection.Format.TextFrame2.TextRange.Characters.Text = "ТОП20 униграмм в семантическом ядре"
With Selection.Format.TextFrame2.TextRange.Characters(1, 14).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 14).Font
.BaselineOffset = 0
.Bold = msoTrue
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0
.Fill.Solid
.Size = 18
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Диаграмма 1").ScaleWidth 1.48125, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Диаграмма 1").ScaleHeight 1.4010414844, msoFalse, _
msoScaleFromBottomRight
ActiveSheet.Shapes("Диаграмма 1").ScaleHeight 1.1449815616, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Диаграмма 1").ScaleWidth 1.0928271519, msoFalse, _
msoScaleFromTopLeft
ActiveChart.ChartGroups(1).SeriesLines.Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(19).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(18).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(17).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(16).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(15).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(14).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(13).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(12).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(11).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(10).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(9).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(8).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(7).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(6).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(5).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(4).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(3).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(2).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Points(1).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(1).Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(2).Points(20).DataLabel.Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(2).Points(19).DataLabel.Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.SeriesCollection(2).Points(18).DataLabel.Select
ActiveSheet.ChartObjects("Диаграмма 1").Activate
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Диаграмма 1").IncrementLeft -96.75
ActiveSheet.Shapes("Диаграмма 1").IncrementTop 9
ActiveWindow.SmallScroll Down:=-80
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 10
ActiveChart.ClearToMatchStyle
' добавление графика конец
' форматирование таблицы
Columns("A:C").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$C"), , xlYes).Name = _
"Таблица5"
Range("Таблица5[[#Headers],[Униграмма]]").Select
Range("Таблица5[[#Headers],[Униграмма]]").AddComment
Range("Таблица5[[#Headers],[Униграмма]]").Comment.Visible = True
Range("Таблица5[[#Headers],[Униграмма]]").Comment.Text Text:= _
"Униграмма (лемма) - это исходная форма слова. "
'Selection.ShapeRange.IncrementLeft -62.25
'Selection.ShapeRange.IncrementTop 58.5
' форматирование таблицы
End Sub |
