Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Макрос для удаления лишних строк. Ошибка Expected end with
 
Изменены строки с 23 по 27.
Макрос для удаления лишних строк. Ошибка Expected end with
 
Код
 ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Макс!A1:F2000", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:=Worksheets("Макс").Range("I2"), TableName:="Сводная Таблица", DefaultVersion:=xlPivotTableVersion14
      Application.GoTo Worksheets("Макс").Range("I2")
Макрос для удаления лишних строк. Ошибка Expected end with
 
Вопрос закрыт, всем спасибо!
Макрос для удаления лишних строк. Ошибка Expected end with
 
Суть в появлении ошибки при запуске макроса, макрос в студии, куда еще короче?
Макрос для удаления лишних строк. Ошибка Expected end with
 
Цитата
vikttur написал:
Макрос для удаления лишних строк.
Макрос для удаления лишних строк. Ошибка Expected end with
 
Добавил, макрос выдает ошибку Run time error '9' : Subscript out of range ссылаясь на 3-ю строку
Макрос для удаления лишних строк. Ошибка 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
Выгрузка из Outlook
 
Всем доброго дня!
Возможно у кого-нибдь есть макрос для выгрузки писем из Outlook в excel?
Интересует дата и время письма, тема, дата и время последнего письма по теме.
Изменено: BMSs - 2 Окт 2017 20:08:10
График командировок
 
Источник данных перенести не удалось, перенес саму таблицу не другой лист (получилось). Дольше буду разбираться. Еще раз спасибо!!!
График командировок
 
jakim, такие формулы мне пока не по плечу, спасибо!! Это не формула это ФОРМУЛИЩЕ! Сейчас пробую перенести исходные данные на Лист2, пока безрезультатно.
Изменено: BMSs - 19 Фев 2017 10:41:48
График командировок
 
Понял о чем речь, это опечатка извиняюсь!! Должно быть с 1-го по 3-е
График командировок
 
Цитата
Юрий М написал: На все города не хватит палитры ))
Городов всего 9 палитры должно хватить.
Цитата
Юрий М написал: Какая связь между городом и символом
Это аббревиатура под которой числятся города в реестре (можно упразднить не принципиально)
Цитата
Юрий М написал: почему у Питера W и закрашено три ячейки вместо двух
Почему у Питера "W", у Тулы "Y", у Челябинска "R" понятия не имею)) закрашено 3 ячейки так как в таблице с условием (та что с желтой шапкой) все трое с 1.03.2017 по 03.03.2017 (включительно) едут в командировку в Питер. Далее Иванов и Петров едут в Тулу с 6.03.2017 по 9.03.2017 на 4 дня.
График командировок
 
Юрий, вы верно говорите, заливка. В идеале у каждого города свой цвет,  после того как в исходных данных будут указаны даты и город например "Питер", в итоговом графике должен сформирован символ города  "W" и ссылаясь на него ячейка должна поменять заливку. Но это в идеале, можно и одним цветом все города. Мне сложнее понять как заполнить период дат нужным символом города.  
Изменено: BMSs - 18 Фев 2017 22:04:10
График командировок
 
Всем привет многоуважаемые гуру екселя! Необходимо на основании исходных подставить в таблицу символ с привязкой к дате и этот символ закрасить в любой цвет. В файлике прикладываю то как это должно выглядеть. Пробовал сводные, условное форматирование, различные формулы, все мимо. Единственная надежда на макрос, но нет понимания как вышеуказанную процедуру записать через макрекодер для дальнейшего редактирования. С языком VBA пока что на "Ваше величество"( не прошу сделать готовый вариант, подскажите хотя бы направление.
Спасибо!!
Обновление данных в сводной таблице
 
Юрий М - Исправил
Sobes - Это просьба
Enka - Спасибо сейчас посмотрю
Обновление данных в сводной таблице
 
Код
Sub Вместимость() 
' 
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) 
Range("A1:F1000").Select 
Range("A2").Activate 
Sheets("Свод макс").Select 
Range("A1").Select 
ActiveSheet.PivotTables("Свод").ChangePivotCache ActiveWorkbook.PivotCaches. _ 
Create(SourceType:=xlDatabase, SourceData:= _ 
"C:\Users\User\Documents\Вместимость\2017\01\Вместимость 23-27.17\[Макрос.xlsm]Вместимость!R1C1:R1000C6" _ 
, Version:=xlPivotTableVersion15) 
Range("F12:F17").Select 
Selection.Copy 
Sheets("Calculation").Select 
End With 
Больше недели бьюсь с сводной таблицей.
Много чего получилось победить самому что-то подсказывали на форуме, но обновление сводной никак не поддается. Пробовал подставлять различные варианты которые находил, но либо макрос работает некорректно либо ошибки.
Есть вариант записать макрос через макрекордер с обновлением, но в таком случае при удалении строк область для обновления уменьшается на количество удаленных срок.

Единственное что получилось это жестко привязать обновление к файлу, но это не вариант. накидаете ссылок или помогите советом.

Макрос удаляет лишние строки, обновляет столбцы с формулами, полученный результат должен  обновится в своде и после исходные данные копируются на следующий лист
Изменено: BMSs - 31 Янв 2017 10:56:00
Как макросу протянуть нужное колличество строк формул
 
Спасибо, все получилось! И спасибо за "последний раз", учту.
Как макросу протянуть нужное колличество строк формул
 
Sanja большое спасибо! С макросами разбираюсь меньше недели и на данный момент строка которую вы прислали для меня как магия)) Но все работает!!!
получилось скрестить то что уже было с вашей строкой, теперь все еще лучше (в один клик). Но, всегда есть но, можно сделать так чтобы макрос проверял и удалял заполненные строки ниже пересчета, оставшиеся после предыдущего документа? Или считал сумму только по колличеству строк нового пересчета а не по всей колонке?
Изменено: BMSs - 20 Янв 2017 13:47:23
Как макросу протянуть нужное колличество строк формул
 
Всем привет, ребята нужна ваша помощь, никак не получается решить уверен пустяковую проблему. В колонки A-D (зеленые) вставляются исходные данные, затем маркрос удаляет все ненужное. Количество строк в исходных данных всегда разное.Тут и начинается самое интересное в колонках E-J (желтые), записаны различные формулы которые необходимо протянуть по вему массиву колонок A-D, чтобы в итоге получилась автосумма в колонке K. Никак не могу научить макрос протягивать нужное колличество строк. Если появляются лишние протянутые строку автосумма не считается. Возможно все формулы в желтых колонках можно записать в макрос, но это для меня космос...
Страницы: 1
Наверх