Страницы: 1
RSS
Макрос для удаления лишних строк. Ошибка Expected end with
 
Код
Sub МАКС()
'
If Worksheets("Макс").PivotTables.Count > 0 Then
    Worksheets("Макс").PivotTables("Свод").TableRange2.Clear
End If
Dim ra As Range, delra As Range, ТекстДляПоиска As String
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    ТекстДляПоиска = "Комплекты"    ' удаляем строки с таким текстом
    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' если в строке найден искомый текст
        If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
            ' добавляем строку в диапазон для удаления
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
    ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Delete
    With ActiveSheet
    .Range("E3:F" & .Cells(.Rows.Count, "F").End(xlUp).Row).ClearContents
    .Range("E2:F2").AutoFill .Range("E2:F" & .Cells(.Rows.Count, "D").End(xlUp).Row)
   
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Макс!R1C4:R1048576C6", Version:=6).CreatePivotTable _
        TableDestination:="Макс!R2C9", TableName:="Сводная таблица", DefaultVersion:=6
    Sheets("Макс").Select
    Cells(2, 9).Select
With ActiveSheet.PivotTables("Сводная таблица").PivotFields("Вид тары")
        .Orientation = xlRowField
        .Position = 1
End With
    ActiveSheet.PivotTables("Сводная таблица").AddDataField ActiveSheet. _
    PivotTables("Сводная таблица").PivotFields("Количество"), _
    "Количество по полю Количество", xlCount
With ActiveSheet.PivotTables("Сводная таблица5").PivotFields( _
        "Количество по полю Количество")
        .Calculation = xlPercentOfTotal
        .NumberFormat = "0,00%"
End With
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP(Calculation!R[8]C[-7],'Макс'!C[1]:C[2],2,0),0)"
    ActiveCell.Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A21"), Type:= _
        xlFillDefault
    ActiveCell.Range("A1:A21").Select
    Selection.Copy
    Sheets("Calculation").Select
            
End Sub
 
В 22-ю строку добавьте то, о чём Вам говорит отладчик.
 
Берем лупу, и считаем количество With и End With.

PS Но какой-то странный Ёжуж (или Ужёж)
Изменено: RAN - 10.04.2018 18:24:37
 
Добавил, макрос выдает ошибку Run time error '9' : Subscript out of range ссылаясь на 3-ю строку
 
Цитата
BMSs написал:
выдает ошибку Run time error '9' : Subscript out of range ссылаясь на 3-ю строку
закомментируйте 3, 4 и 5 строки Вашего кода
оптимальный вариант - закомментировать все, кроме строк:
Sub МАКС()
и
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
vikttur написал:
Макрос для удаления лишних строк.
 
Не писал такого Виктор )
BMSs,  Вы не умеете пользоваться цитированием. И не пользуйтесь - ответить можно и без него. А с названием у Вас опять беда: что можно из него понять? Единственное, это то,что у Вас имеется такой макрос. И что? Неужели нельзя кратко сформулировать суть проблемы?
 
Суть в появлении ошибки при запуске макроса, макрос в студии, куда еще короче?
 
Вопрос закрыт, всем спасибо!
 
Поделиться решением забыли.
 
Код
 ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Макс!A1:F2000", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:=Worksheets("Макс").Range("I2"), TableName:="Сводная Таблица", DefaultVersion:=xlPivotTableVersion14
      Application.GoTo Worksheets("Макс").Range("I2")
 
Изменены строки с 23 по 27.
Страницы: 1
Наверх