Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » kornilcdima
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Создание новых листов с именами из заданного списка
 
#
16.11.2015 13:23:43
До сих пор актуально. Что нужно прописать в макросе, чтобы
Цитата
kornilcdima написал: На листе "17" в списке ФИО есть Демушкина Александра Александровна , длина больше 31 знака, и макрос из-за этого не выполняется.
По прежнему актуально. Как это сделать?
Сейчас, если ФИО более 31 знака, макрос выполняется с ошибкой.
 
Перейти    
Проверка: существует лист в данной книге?
 
#
10.11.2015 08:04:57
The_Prist, очень благодарю за ценные советы
 
Перейти    
Проверка: существует лист в данной книге?
 
#
09.11.2015 12:49:05
Почему то все равно вот такую фигню создает.
В первый раз макрос создает 2 листа с ФИО Романовская Л.А и Тикшаев С.П.
Во второй раз, так как уже указанные ФИО уже существуют, создает 2 листа: Лист50 и Лист49 (как на приложенной картинке)

[USER=6]The_Prist[/USER, подскажите, что в данном случае происходит? Если лист не существует, создается лист с названием "Новый лист"?
Сейчас код такой:
Код
Sub new_sh_after()
Dim i As Object
Dim Sh As Worksheet
On Error Resume Next
Finalrow = Range("A1048576").End(xlUp).Row
 For Each i In Sheets("17").Range("A1:A" & Finalrow)
Err.Clear
 Sheets("Pivot").Select
    ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("ФИО"). _
        ClearAllFilters
    ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("ФИО"). _
        CurrentPage = i.Value
 If Err.Number = 0 Then
 Sheets("Pivot").Range(Range("A4"), Range("B4").End(xlDown)).Copy
     Worksheets.Add(After:=Worksheets("17")).Name = Left(i, 31)
  
If Not Sh_Exist(Left(i, 31)) Then
    Sheets.Add(, Sheets(Sheets.Count)).Name = "Новый лист"
Else
   
End If   ActiveSheet.Range("A1").Select
     
    With Selection
 .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End With
    End If
Next i
          
End Sub
 Function Sh_Exist(sName As String) As Boolean
    Dim wsSh As Worksheet
    On Error Resume Next
    Set wsSh = Sheets(sName)
    Sh_Exist = Not wsSh Is Nothing
End Function
Изменено: kornilcdima - 09.11.2015 17:28:00
 
Перейти    
Проверка: существует лист в данной книге?
 
#
06.11.2015 10:24:09
Коллеги, прошу помощи. Знаю, подобные темы уже есть на форуме, но я не смог воспользоваться советами, данными в них. Я еще весьма плохо понимаю в vba.
Суть следующая: у меня есть макрос, который создает новые листы с названием из определенного списка ФИО. Когда листы с нужными именами есть, я снова выполняю макрос с тем же списком имен, в этом случае макрос создает листы: "Лист1", "Лист2" и т. д. Как сделать, чтобы он не создавал новые листы, если имя листа повторяется?
Сейчас макрос выглядит так. Не знаю как в него добавить новое условие.
Код
Sub new_sh_after()
Dim i As Object
On Error Resume Next
Finalrow = Range("A1048576").End(xlUp).Row For Each i In Sheets("17").Range("A1:A" & Finalrow)
Err.Clear
 Sheets("Pivot").Select
    ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("ÔÈÎ"). _
        ClearAllFilters
    ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("ÔÈÎ"). _
        CurrentPage = i.Value
 If Err.Number = 0 Then
 Sheets("Pivot").Range(Range("A4"), Range("B4").End(xlDown)).Copy
   
   
  Worksheets.Add(after:=Worksheets("17")).Name = Left(i, 31)
   ActiveSheet.Range("A1").Select
     
    With Selection
 .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End With
End If
Next i
          
End Sub
Изменено: kornilcdima - 09.11.2015 09:47:51
 
Перейти    
Пропала строка состояния, excel 2013
 
#
06.11.2015 07:57:05
Странно, после манипуляций с отключением макросов и перезагрузкой вроде помогло.
 
Перейти    
Пропала строка состояния, excel 2013
 
#
06.11.2015 07:25:17
Цитата
Попробуйте запустить Excel с запрещенными макросами - проблема повторится?
Попробовал не помогло. Причем строки нет в каждом новом открытом файле. Эта фигня происходит на рабочем компьютере и раньше такого не было пока не установили централизованно надстройку SmartView
 
Перейти    
Пропала строка состояния, excel 2013
 
#
05.11.2015 15:30:39
У меня почему-то пропала строка состояния.
Теперь вынужден каждый раз, когда запускаю файл, пользоваться макросом.
Можно как то это дело включить через интерфейс экселя?
Код
Sub hideStatusBar()
With Application.CommandBars("Status Bar")
   .Visible = Not .Visible
End With
End Sub
 
Перейти    
Выводить в конце цикла информацию о возникших ошибках
 
#
29.10.2015 09:55:00
Спасибо большое за решение
 
Перейти    
Выводить в конце цикла информацию о возникших ошибках
 
#
29.10.2015 09:06:57
Есть макрос который перебирает ФИО из списка и производит ряд действий в зависимости от выбранного ФИО. А именно фильтрует по ФИО в сводной и копирует сводную на новый лист с названием листа (соответствующему ФИО).

Что нужно прописать, чтобы после завершении работы макроса выводилось сообщение о том какие ФИО оказались ошибочными и по ним не создались листы и таблицы?

Заранее благодарю.
Код
Sub new_sh_after()
Dim i As Object
On Error Resume Next
Finalrow = Range("A1048576").End(xlUp).Row 

For Each i In Sheets("17").Range("A1:A" & Finalrow)
Err.Clear
 Sheets("Pivot").Select
    ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("ФИО"). _
        ClearAllFilters
    ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("ФИО"). _
        CurrentPage = i.Value
 If Err.Number = 0 Then
 Sheets("Pivot").Range(Range("A4"), Range("B4").End(xlDown)).Copy
   
   
  Worksheets.Add(after:=Worksheets("17")).Name = Left(i, 31)
   ActiveSheet.Range("A1").Select
     
    With Selection
 .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End With
End If
Next i         
End Sub
Изменено: kornilcdima - 29.10.2015 11:24:14
 
Перейти    
При ошибке цикл продолжить со след значения
 
#
29.10.2015 07:13:45
Большое спасибо, работает.
 
Перейти    
При ошибке цикл продолжить со след значения
 
#
28.10.2015 14:34:45
Тогда макрос создает страницу с неправильным названием.

Неправильное название - то, которого нет в Database и соответственно в Pivot
Мне нужно, чтобы не создавался новый лист, если на этом этапе возникла ошибка. А нужно, чтобы выбирал следующее ФИО из списка и проводил дальнейшие операции.

Ввел неправильное ФИО "Лал". Получается лист "Лал" и на нем сводная без фильтров.
Изменено: kornilcdima - 29.10.2015 11:21:56
 
Перейти    
При ошибке цикл продолжить со след значения
 
#
28.10.2015 13:43:47
Столкнулся с проблемой, не знаю как прописать операцию в макросе.

У меня есть сводная таблица (лист "свод"), из которой я копирую данные на новый лист, который предварительно создается. Название листа задается из диапазона на листе "17", при этом фильтр в сводной тоже изменяется в зависимости от выбранного значения на листе "17".
Если у меня есть не существующее ФИО, то цикл прерывается на выборе фильтра в сводной таблице.

Как мне прописать, чтобы цикл переходил к следующему значению в диапазоне (на листе "17") ?

Я понимаю, что мне нужно прописать что-то вроде On Error GoTo, но что конкретно. Заранее благодарю.
Код
Sub new_sh_after()
Dim i As Object For Each i In Sheets("17").Range("A1:A3")
 
 Sheets("Pivot").Select
 
    ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("ФИО"). _
        ClearAllFilters
    ActiveSheet.PivotTables("СводнаяТаблица1").PivotFields("ФИО"). _
        CurrentPage = i.Value
     
 Sheets("Pivot").Range(Range("A4"), Range("B4").End(xlDown)).Copy
 
 
  Worksheets.Add(after:=Worksheets("17")).Name = Left(i, 31)
   ActiveSheet.Range("A1").Select
   
   With Selection
 .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End With
    
        Next i
        
End Sub
 
Перейти    
Создание новых листов с именами из заданного списка
 
#
28.10.2015 10:11:19
Цитата
JayBhagavan написал: Вы уверены, что Вам надо выделять лист?
Это нужно для остальной части макроса. Большое спасибо )
 
Перейти    
Создание новых листов с именами из заданного списка
 
#
28.10.2015 07:21:13
Спасибо, помогло. Листы добавляются как надо.
А как мне теперь через Select выбрать лист i ?
Код
Worksheets(i).Select
 
Перейти    
Создание новых листов с именами из заданного списка
 
#
27.10.2015 16:03:27
Но главная проблема, что макрос не хочет выполняться если ФИО больше 31 знака.
П.С. кто-н знает как задать имя листа через переменную?
Код
Sub viborlista()
Dim i As Integeri = 17
Worksheets(i).Name.SelectEnd Sub
 
Перейти    
Создание новых листов с именами из заданного списка
 
#
27.10.2015 13:19:43
Может уже была подобная тема, но я не смог найти такую.
У меня есть список с ФИО на листе "17".
Использую код:
Код
Sub new_sh()
Dim i As Object
 For Each i In Sheets("17").Range("A1:A3")
  Worksheets.Add.Name = i
        Next i
End Sub

На листе "17" в списке ФИО есть Демушкина Александра Александровна , длина больше 31 знака, и макрос из-за этого не выполняется.
При этом мне нужно, чтобы листы создавались после листа "17"

Такой код не подходит (
Код
Worksheets.Add After:=worksheets("17").Name = i
Подскажите пожалуйста что не так. Файл прикрепляю
 
Перейти    
макросом скопировать таблицу одну под другую, макрос, который перебирает фильтры таблицы и копирует с каждым новым фильтром таблицу на отдельный лист одна под другую
 
#
22.05.2015 08:27:57
Ошибка, д.б название sheet1
Изменено: kornilcdima - 22.05.2015 15:23:00
 
Перейти    
макросом скопировать таблицу одну под другую, макрос, который перебирает фильтры таблицы и копирует с каждым новым фильтром таблицу на отдельный лист одна под другую
 
#
21.05.2015 15:53:05
Прошу помощи. К теме прикреплен файл-пример.

Нужно, чтобы, макрос перебирал по очереди из списка номера месяца, затем сегмент.
Затем полученную таблицу копировал вниз одну под другой на sheet3 (на листе есть шаблон как должно получиться),
Я не знаю как сделать такой цикл. Начало макроса в Macro2 и корявые попытки в Macro1
Как сделать цикл ничего не понимаю, но сделать как то надо. К теме прикреплен пример. Это конечно примитивная версия файла, с которым я работаю. С помощью него я бы смог понять принцип. Знаю, что это неочень сложно для кого-то, но совсем я не сведущ.
Заранее большое спасибо!
Изменено: kornilcdima - 22.05.2015 02:43:09
 
Перейти    
динамический диапазон с помощью vba, Нужно копировать формулу на столько строк, сколько есть в сводке
 
#
11.03.2015 09:27:40
Это просто абстрактный пример, чтобы я смог понять принцип как это сделать. У меня на одном листе сводка, а на втором в зависимости от названий в сводке выполняются разные формулы, которые прописаны только в верхней строке. Почему только в верхней - потому что иначе файл будет весить очень много.
Своими силами я могу прописать, чтобы копировалось на 1000 строк например.
Сначала в 1000 строк, кроме 1ой прописываю ="", а затем то, что ниже
Код
Range("A6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste

Определять количество строк мне нужно, чтобы файл работал побыстрее. Вдруг нужно только 50 строк формул, а не 1000, а он ведь накопирует все 1000 и будет вести пересчет.

Я бы скинул файл, но стоит ограничение 100кб, могу в личку.
Изменено: kornilcdima - 11.03.2015 09:52:11
 
Перейти    
динамический диапазон с помощью vba, Нужно копировать формулу на столько строк, сколько есть в сводке
 
#
11.03.2015 07:30:43
Прошу прощения, что то наглупил  
 
Перейти    
динамический диапазон с помощью vba, Нужно копировать формулу на столько строк, сколько есть в сводке
 
#
10.03.2015 21:07:08
День добрый! Помогите сделать такую штуку, в vba я полный нуп или хотя бы, подскажите...
В файле 2 листа. На 1 листе всегда в 6ой строке прописаны разные формулы в диапазоне A6:S6. Нужно, чтобы эти формулы копировались на столько строк вниз, сколько строк в сводной таблице на 2м листе.

Как прописать это?
Я только догадываюсь, что сначала нужно объявить эту строку Dim A6:S6 As Range
For each range далее прописывается формула смещения для создания динамического диапазона =offset(a6;0;19;count(A6:A10000);1))
 
Перейти    
Страницы: 1
Наверх