Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
[ Закрыто ] Ошибка при генерации файлов
 
#1
28.03.2016 12:56:14
Добрый день.
Формирую реестры определенные процедурой, 1 раз запускается - выполняется, второй раз запускаешь - выдается ошибка 400. В окне выбираешь ОК - открывается лист и исходными данными (весь лист выделен), переходишь на основной лист с кнопками, пытаешься выполнить снова - выполняется.

Пытался очистить буфер обмена CutCopyMode, но не помогает = в буфере остаются сгенерированные файлы.

Код
Public Sub BAK_BIK()
   
'   Отключаем моргание экрана при выполнении
    Application.ScreenUpdating = False    Application.DisplayAlerts = False
'   Очищаем буфер обмена
    Application.CutCopyMode = False
    
'   Получаем имя листа
    RCVNAME = Worksheets("Макрос").Range("E2").Value
    
    Dim lLastRow
    Dim lLastCol    '   Последняя строка
    lLastRow = Worksheets(RCVNAME).UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
    '   Последний стобец
    lLastCol = Worksheets(RCVNAME).UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1    Worksheets(RCVNAME).Select
    Selection.AutoFilter
    Worksheets(RCVNAME).Cells(lLastRow, lLastCol).AutoFilter Field:=17, Criteria1:="<>WARRANTOR"
    Worksheets(RCVNAME).Cells(lLastRow, lLastCol).AutoFilter Field:=5, Criteria1:="=BAK" _
        , Operator:=xlOr, Criteria2:="=BIK"
    Worksheets(RCVNAME).Cells(lLastRow, lLastCol).AutoFilter Field:=7, Criteria1:="<>0"
'   Создаем каталог
        Dim folder
        Dim folder2
        Dim FilePath
        FilePath = "BIK_BAK"'        MkDir ThisWorkbook.Path + "\" + "BIK_BAK"
        folder = ThisWorkbook.Path & "\" & FilePath     '   MsgBox folder
'   Если нет такого каталога, то создаем.
        If CreateObject("Scripting.FileSystemObject").FolderExists(folder) = True Then
             Else
                MkDir folder
        End If'   Выбираем отфильтрованные столбцы
        Worksheets(RCVNAME).Range("AS:AS,AW:AW,AX:AX,AY:AY,E:E,G:G,I:I").Copy
       
'   Добавляем новый лист и вставляем на него скопированные данные
        Sheets.Add(, Sheets(Sheets.Count)).Name = "BIK_BAK"
        Worksheets("BIK_BAK").Paste        
    '   Количество строк                Dim Count_str As Integer
                Dim Count_reestr As Integer
                Dim Count_str_v_it As Integer                Count_str = Application.WorksheetFunction.CountIfs(Sheets("BIK_BAK").Range("A:A"), "<>")
                Count_reestr = Worksheets("Макрос").Range("G12").Value
                Count_str_v_it = Fix((Count_str / Count_reestr)) + 1 ' fix, отбрасывает дробную часть, + 1 - когда не целое число получается
           
                
    '            MsgBox Count_str_v_it
                Dim D_end As Integer
                D_end = Count_str_v_it * Count_reestr                    Dim n1
                    n1 = 1
                    Dim i
                    For i = n1 To D_end Step Count_str_v_it
                                Worksheets("BIK_BAK").Range(Worksheets("BIK_BAK").Cells(i, 1), _
                                Worksheets("BIK_BAK").Cells(i + Count_str_v_it - 1, 7)).Copy
                               
                                Sheets.Add(, Sheets(Sheets.Count)).Name = "BIK_BAK" & i
                                Worksheets("BIK_BAK" & i).Paste
        
    
                            '    Подготавливаем данные для генерации файла
                                            Dim Arr
                                            Dim Headers
                                            Arr = Worksheets("BIK_BAK" & i).Range("A1:G" & D_end).Value
                                            Headers = Array("Тип", "DPD", "Регион", "ID клиента", "Имя", "Отчество", "Фамилия", "Код ручного обзвона")
                            
                                            SaveArray Arr, Headers, folder, "Реестр" & i ' создаём из массива Arr файл Excel с именем СКЛАД
                            '    Отключаем уведомления
                                        Application.DisplayAlerts = False
                            '    Удаляем листы
                                        Worksheets("BIK_BAK" & i).Delete
    
                      Next
'    Удаляем листы
            Worksheets("BIK_BAK").Delete            Worksheets("Макрос").Activate
            
            '   Очищаем буфер обмена
            Application.CutCopyMode = False
    
            MsgBox ("Формирование завершено")
                        
End Sub
 
 
 
#2
28.03.2016 13:00:25
Код
Worksheets(RCVNAME).Select
Selection.AutoFilter
вот это явно лишнее.
Вместо
Код
Worksheets("BIK_BAK").Paste
лучше указывать конкретные ячейки:
Код
Worksheets("BIK_BAK").Cells(1,1).PasteSpecial xlPasteAll
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#3
28.03.2016 13:06:45
Цитата
The_Prist написал:
Worksheets(RCVNAME).SelectSelection.AutoFilterвот это явно лишнее.
без этого куска сразу ошибка 400
 
 
 
#4
28.03.2016 13:10:37
у меня файла нет, проверять не на чем. Но эта строка обращается к выделенным на листе ячейкам - а что там выделено неясно, код ничего не выделяет.
А еще Вы бы хоть написали на какой строке ошибка появляется(в исходном коде). А то сидеть гадать что-то некогда.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#5
28.03.2016 13:13:27
Попробуйте :
Код
Worksheets(RCVNAME).AutoFiltermode = 0
Я сам - дурнее всякого примера! ...
 
 
 
#6
28.03.2016 13:31:09
Цитата
The_Prist написал: у меня файла нет
Вот лист, с которого данный берутся, т.е RCV
Изменено: Владимир Лыткин - 28.03.2016 13:46:46
 
 
 
#7
28.03.2016 13:37:55
Ошибка (при втором запуске) возникает при попытке снять автофильтр, который не установлен

вариант решения 1: (отключаем вывод ошибок, снимаем автофильтр)
Код
On Error Resume Next
Worksheets(RCVNAME).ShowAllData


вариант решения 2: (снимаем автофильтр только если он включен)
Код
if Worksheets(RCVNAME).AutoFiltermode=TRUE then Worksheets(RCVNAME).AutoFiltermode=FALSE
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#8
28.03.2016 13:49:52
Цитата
Игорь написал: вариант решения 2...
ОК, помогло, в начале вставил.
Подскажите, в буфере обмена файлики сгенерированные висят, их может быть за 1 запуск процедуры до 300 штук, почему CutCopyMode не срабатывает, ведь он должен очищать вроде буфер.
 
 
 
#9
28.03.2016 13:57:36
Цитата
Владимир Лыткин написал:
Вот лист, с которого данный берутся, т.е RCV
ну и как следствие ошибка, т.к. листа "Макрос" нет.
Заменил на единственно возможное значение.
Я буду стоять на своем: убираем эти строки:
Код
Worksheets(RCVNAME).Select
Selection.AutoFilter

то, что идет далее чуть модернизируем:
Код
Worksheets(RCVNAME).Cells(1, 1).Resize(lLastRow, lLastCol).AutoFilter Field:=17, Criteria1:="<>WARRANTOR"
    Worksheets(RCVNAME).Cells(1, 1).Cells(lLastRow, lLastCol).AutoFilter Field:=5, Criteria1:="=BAK" _
        , Operator:=xlOr, Criteria2:="=BIK"
    Worksheets(RCVNAME).Cells(1, 1).Cells(lLastRow, lLastCol).AutoFilter Field:=7, Criteria1:="<>0"

а вот эти строки:
Код
'   Выбираем отфильтрованные столбцы
        Worksheets(RCVNAME).Range("AS:AS,AW:AW,AX:AX,AY:AY,E:E,G:G,I:I").Copy
       
'   Добавляем новый лист и вставляем на него скопированные данные
        Sheets.Add(, Sheets(Sheets.Count)).Name = "BIK_BAK"
        Worksheets("BIK_BAK").Paste

я бы заменил так:
Код
'   Добавляем новый лист и вставляем на него скопированные данные
        Sheets.Add(, Sheets(Sheets.Count)).Name = "BIK_BAK"
'   Выбираем отфильтрованные столбцы
        Worksheets(RCVNAME).Range("AS:AS,AW:AW,AX:AX,AY:AY,E:E,G:G,I:I").Copy Worksheets("BIK_BAK").Cells(1,1)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#10
29.03.2016 05:28:56
The_Prist, Спасибо, с Вашими исправлениями заработало.
 
 
 
#11
29.03.2016 06:02:12
The_Prist, если применяю другой фильтр, т.е. warrantor  и BMB, то  к нужному мне количеству строк добавляется еще 1 строка, на которой установлены фильтры, т.е. BIK, а она мне счас не нужна, но нужна в том случае, если фильтр по bik, bak.
Подскажите как поправить?
 
 
 
#12
29.03.2016 08:46:26
help!
 
 
 
#13
29.03.2016 10:33:50
Цитата
Владимир Лыткин написал: help
Вот-вот. Читайте help по методу autoFilter. Какие поля указываете для фильтрации - те и фильтруются.

P.S. Вопрос к теме отношения как такового не имеет. Значит вполне есть смысл создавать новую в таких случаях.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#14
31.03.2016 05:56:18
Добавилась дополнительная задача к процедуре: если остаются незадействованные строки - распределять их по созданным файлам.
т.е. есть 756 записей, нужно их распределить на 45 файлов, получается 16,8, если брать 16, то получаем в итоге 720 записей ( остаток 36 записей), если брать 17, то не хватает 9 записей, это если более - менее равнозначное количество записей и файлов. А если записей 78 и нужно сформировать 35 файлов (2,28 записей на файл), то в этом случает если брать 3, то из 35 файлов, с данными будет только 26 (78/3=26 файлов), а чётко нужно сформировать 35. Поэтому нужно взять по 2 записи => получится 35 файлов по 2 записи, остается 8 незадействованных, и эти 8 нужно раскидать в какие угодно 35 файлов, т.е. 26 будет по 2 записи, а 8 файлов - по 3.
Вот последний вариант кода:
Код
Public Sub BAK_BIK()
       
'   Отключаем моргание экрана при выполнении
    Application.ScreenUpdating = False
    
'   снимаем автофильтр только если он включен
    If Worksheets(RCVNAME).AutoFilterMode = True Then Worksheets(RCVNAME).AutoFilterMode = False    Application.DisplayAlerts = False
'   Очищаем буфер обмена
    Application.CutCopyMode = False
    
'   Получаем имя листа
    RCVNAME = Worksheets("Макрос").Range("E2").Value'   Определяем имя
    Dim Type_reestr
    Type_reestr = "BAK_BIK"    Dim lLastRow
    Dim lLastCol
 
'   Последняя строка
    lLastRow = Worksheets(RCVNAME).UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
'   Последний стобец
    lLastCol = Worksheets(RCVNAME).UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1'   Фильтруем данные
    Dim Crit1
    Dim Crit2
    Dim Crit3
    Crit1 = "<>WARRANTOR"
    Crit2 = "=BAK"
    Crit3 = "=BIK"
    
        Worksheets(RCVNAME).Cells(1, 1).Resize(lLastRow, lLastCol).AutoFilter Field:=17, Criteria1:="<>WARRANTOR"
        Worksheets(RCVNAME).Cells(1, 1).Cells(lLastRow, lLastCol).AutoFilter Field:=5, Criteria1:=Crit2 _
            , Operator:=xlOr, Criteria2:=Crit3
        Worksheets(RCVNAME).Cells(1, 1).Cells(lLastRow, lLastCol).AutoFilter Field:=7, Criteria1:="<>0"'   Создаем каталог
        Dim folder
        Dim folder2
        Dim FilePath
        FilePath = Type_reestr'   Определяем путь\имя каталога
        folder = ThisWorkbook.Path & "\" & FilePath'   Если нет такого каталога, то создаем.
        If CreateObject("Scripting.FileSystemObject").FolderExists(folder) = True Then
             Else
                MkDir folder
        End If
        
'   Добавляем новый лист и вставляем на него скопированные данные
        Sheets.Add(, Sheets(Sheets.Count)).Name = Type_reestr
'   Выбираем отфильтрованные столбцы и вставляем на новый лист
     Worksheets(RCVNAME).Range("AS:AS,AW:AW,AX:AX,AY:AY,E:E,G:G,I:I").Copy Worksheets(Type_reestr).Cells(1, 1)
'   Удаляем 1 пустую строку.
     Worksheets(Type_reestr).Cells(1, 1).EntireRow.Delete
      
'   Количество строк
                Dim Count_str As Integer
                Dim Count_str_v_it As Integer
 '   Получаем количество реестров из ячейки
                Dim Count_reestr As Integer
                Count_reestr = Worksheets("Макрос").Range("G12").Value                Count_str = Application.WorksheetFunction.CountIfs(Sheets(Type_reestr).Range("A:A"), "<>")'MsgBox D_end
                Count_str_v_it = Fix((Count_str / Count_reestr)) + 1 ' fix, отбрасывает дробную часть, + 1 - когда не целое число получается
                
                Dim D_end As Integer
                D_end = Count_str_v_it * Count_reestr
           
                    Dim n1
                    n1 = 1
                    Dim i                    For i = n1 To D_end Step Count_str_v_it
                                Worksheets(Type_reestr).Range(Worksheets(Type_reestr).Cells(i, 1), _
                                Worksheets(Type_reestr).Cells(i + Count_str_v_it - 1, 7)).Copy
                               
                                Sheets.Add(, Sheets(Sheets.Count)).Name = Type_reestr & i
                                Worksheets(Type_reestr & i).Paste
        
    
                            '    Подготавливаем данные для генерации файла
                                            Dim Arr
                                            Dim Headers
                                            Arr = Worksheets(Type_reestr & i).Range("A1:G" & D_end).Value
                                            Headers = Array("Тип", "DPD", "Регион", "ID клиента", "Имя", "Отчество", "Фамилия", "Код ручного обзвона")
                            
                                            SaveArray Arr, Headers, folder, "Реестр" & i ' создаём из массива Arr файл Excel с именем СКЛАД
                            '    Отключаем уведомления
                                        Application.DisplayAlerts = False
                            '    Удаляем листы
                                        Worksheets(Type_reestr & i).Delete
    
                      Next
'    Удаляем листы
 '   Worksheets(Type_reestr).Delete
    Worksheets("Макрос").Activate
            
'   Очищаем буфер обмена
    Application.CutCopyMode = False
    MsgBox ("Формирование завершено")End Sub
 
 
 
#15
31.03.2016 10:06:40
Тема закрыта.
Вы упорно не читаете то, что пишут:
Цитата
The_Prist написал:
Вопрос к теме отношения как такового не имеет. Значит вполне есть смысл создавать новую в таких случаях.
Поэтому ознакомьтесь с правилами форума - там мало написано, но очень полезно.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
Страницы: 1
Читают тему
Наверх