Поиск по ключевым словам на нескольких листах, а затем создание сводки - PullRequest
Новая
       16

Поиск по ключевым словам на нескольких листах, а затем создание сводки

0 голосов
/ 25 июня 2019

У меня есть код для создания нужной мне сводной таблицы, но я хочу добавить кодировку для поиска ключевого слова на каждой вкладке и, если найден, выделите вкладку и создайте сводную таблицу. Начните поиск KeyWord = "XXXXX" на первой вкладке и, если он найден, выделите и создайте сводную область ниже, затем перейдите к следующей вкладке, пока не закончите. Если ключевое слово не найдено, ничего не делайте и переходите к следующей вкладке. 

Sub Create pivot()
ActiveSheet.Select
With ActiveWorkbook.ActiveSheet.Tab
    .Color = 65535
    .TintAndShade = 0
End With
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim pc As PivotCache

Set shtSrc = ActiveSheet
Set shtDest = shtSrc.Parent.Sheets.Add()
shtDest.Name = shtSrc.Name & "-Pivot"

Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
    SourceData:=shtSrc.Range("A1").CurrentRegion)
pc.CreatePivotTable TableDestination:=shtDest.Range("A3"), _
    TableName:="PivotTable1"
With shtDest.PivotTables("PivotTable1")
    .ColumnGrand = True
    .HasAutoFormat = True
    .DisplayErrorString = False
    .DisplayNullString = True
    .EnableDrilldown = True
    .ErrorString = ""
    .MergeLabels = False
    .NullString = ""
    .PageFieldOrder = 2
    .PageFieldWrapCount = 0
    .PreserveFormatting = True
    .RowGrand = True
    .SaveData = True
    .PrintTitles = False
    .RepeatItemsOnEachPrintedPage = True
    .TotalsAnnotation = False
    .CompactRowIndent = 1
    .InGridDropZones = False
    .DisplayFieldCaptions = True
    .DisplayMemberPropertyTooltips = False
    .DisplayContextTooltips = True
    .ShowDrillIndicators = True
    .PrintDrillIndicators = False
    .AllowMultipleFilters = False
    .SortUsingCustomLists = True
    .FieldListSortAscending = False
    .ShowValuesRow = False
    .CalculatedMembersInFilters = False
    .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotCache
    .RefreshOnFileOpen = False
    .MissingItemsLimit = xlMissingItemsDefault
    End With
   ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
   ActiveWorkbook.ShowPivotTableFieldList = True
   With ActiveSheet.PivotTables("PivotTable1").PivotFields("Suspense?")
    .Orientation = xlRowField
    .Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField 
ActiveSheet.PivotTables( _
    "PivotTable1").PivotFields("APC LC2 Amount"), "Sum of APC LC2 
Amount", xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField 
ActiveSheet.PivotTables( _
    "PivotTable1").PivotFields("Partner LC2 Amount"), "Sum of Partner LC2 
Amount", _
    xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField 
ActiveSheet.PivotTables( _
    "PivotTable1").PivotFields("LC2 Amount"), _
    "Sum of LC2 amount", xlSum

 End Sub
...