Страницы: 1
RSS
BA переход к следующему действию если файла нет, VBA ошибка если файл отсутствует в папке
 
Добрый день.

Написал Макрос для сверки данных из двух источников, один формирует данные в одном фале, другой источник несколько.
Название файлов задается исходя из даты и других параметров. Короче, данные из разных источников собираются в одном общем файле и сверяются - это работает. Загвоздка в том, что из второго источника максиму должно быть 5 файлов, но может и меньше и когда макрос натыкается на то, что файла нет возникает ошибка. On error и  переход к следующему файлу работает только один раз в программе, через IF и номер ошибки тоже не получается. Как можно сделать, если одного, двух фалов нет, макрос переходил к следующему действию и заканчивался?
Resume next думаю не подойдёт, тк после открытия файла восполняются действия с ним филтраци, выделение нужных строк и перенос в общий файл. И если прописать resume next эти действия будут выполнять в активном таблице, нужен именно переход к следующему файлу и выполнения действий уже над ним, если он есть.
Через IF Then пробовал как вы и написали. Я не особо понимаю как несколько раз приметь его, допустим 4 раза. Я прописывал его перед каждым открытием каждого файла и завершал end if, но он выходила ошибка что нет блока для end if. Т.е. Workbooks.Open Filename:= iFile1... далее действия над файлом, фильтрация, выделение необходимых данных, перенос в основную книгу, закрытие открытого файла.


И подскажите, как правильно вставлять код.  
 
RADLE, прикоол?
https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=136650&...
Не бойтесь совершенства. Вам его не достичь.
 
Нет, там никто не отвечает, я не правильно опубликовал код и не могу удалить сообщения. Как правильно вложить код тоже не знаю.

Короче, весело у вас. Там никто ответить не может, здесь сразу прилетел ответ.  
 
RADLE,  для оформления кода есть кнопка - выделяете свой макрос и нажимаете на кнопку <...>. А странно там есть ответы.
удалить сообщение не сможете - только модератор  вы нужные через кнопку изменить  отредактируйте
Изменено: Mershik - 25.01.2021 14:54:26
Не бойтесь совершенства. Вам его не достичь.
 
Код
Sub OTKR()

ddate = DateAdd("d", 0, Sheets("Menu").Cells(3, 3).Value)
ddate1 = ddate + 1
ddate2 = ddate + 2
ddate3 = ddate + 3
fDate = Format(ddate, "m\/d\/yyyy")

Dim ITK, IOK As String
Dim iLast As Long
Dim iFirst As String
Dim iName As String
Dim iName1 As String
Dim iName2 As String
Dim iName3 As String
Dim iName4 As String

ITK = ThisWorkbook.Name
 
sDay = Format(ddate, "dd")
sMonth = Format(ddate, "mm")
sYear = Format(ddate, "yyyy")
sDay1 = Format(ddate1, "dd")
sMonth1 = Format(ddate1, "mm")
sYear1 = Format(ddate1, "yyyy")
sDay2 = Format(ddate2, "dd")
sMonth2 = Format(ddate2, "mm")
sYear2 = Format(ddate2, "yyyy")

iYmd = sYear + sMonth + sDay
iYmd1 = sYear1 + sMonth1 + sDay1
iYmd2 = sYear2 + sMonth2 + sDay2

iName = "33_D" & iYmd & ".xlsx"
iName1 = "33_D" & iYmd1 & ".xlsx"
iName2 = "33_D" & iYmd2 & ".xlsx"
iName3 = "16_D" & iYmd1 & ".xlsx"
iName4 = "16_D" & iYmd2 & ".xlsx"

iPapka = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName
iPapka1 = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName1
iPapka2 = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName2
iPapka3 = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName3
iPapka4 = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName4

    
    indir = sDay + sMonth
    odir = "C:\Users\eabuzyarov\Desktop\d140\d140_" & indir & ".txt"
    IOK = Dir(odir)
    
    inp = Mid(odir, 4)
    inp2 = Right(inp, 13)
    Inp3 = Left(inp, 3)
    SSheet1 = Mid(ddate, 4)
    SSheet2 = Left(SSheet1, 2)
    
     With Application
       .ScreenUpdating = False
       .Visible = True
       .DisplayAlerts = False
   End With
    
    Workbooks.OpenText Filename:= _
        odir, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
        
Columns("A:AQ").Select
Selection.AutoFilter
Selection.AutoFilter Field:=25, Criteria1:="<>0", Operator:=xlAnd
Selection.AutoFilter Field:=17, Criteria1:="<>*Direct*", Criteria2:="<>*cash*", Operator:=xlAnd

Range("Z2:Z1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(LastRow, 1).Offset(1, 0).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("O2:O1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 1).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("Q2:Q1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 2).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("V2:V1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 3).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("AA2:AA1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 4).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("Y2:Y1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 5).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("AK2:AK1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 6).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("T2:T1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 7).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("U2:U1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 8).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

lLastCol = Cells(LastRow + 1, Columns.Count).End(xlToLeft).Column
lLastRow = Cells(LastRow + 1, 3).End(xlDown).Row

ActiveWorkbook.Worksheets(SSheet2).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(SSheet2).Sort.SortFields.Add Key:=Range(Cells(LastRow + 1, 6), Cells(LastRow, 6)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(SSheet2).Sort
        .SetRange Range(Cells(LastRow + 1, 1), Cells(lLastRow, 9))
        .Header = xlNo
        .MatchCase = True
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Windows(IOK).Activate
Windows(IOK).Close

Workbooks.OpenText Filename:= _
        iPapka1, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
        
INK = Dir(iPapka)
INK1 = Dir(iPapka1)
INK2 = Dir(iPapka2)
INK3 = Dir(iPapka3)
INK4 = Dir(iPapka4)
            
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd

Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete

 ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
        xlFilterValues, Criteria2:=Array(2, fDate)
        
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy

Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK1).Activate

ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(INK1).Activate
Windows(INK1).Close

iLast = Cells(Rows.Count, 11).End(xlUp).Row

Workbooks.OpenText Filename:= _
        iPapka2, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd

Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete

 ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
        xlFilterValues, Criteria2:=Array(2, fDate)
        
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy

Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(INK2).Activate

ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(INK2).Activate
Windows(INK2).Close

iLast = Cells(Rows.Count, 11).End(xlUp).Row

Workbooks.OpenText Filename:= _
        iPapka3, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd

Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete

 ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
        xlFilterValues, Criteria2:=Array(2, fDate)
        
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy

Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste



Windows(INK3).Activate
ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(INK3).Activate
Windows(INK3).Close

iLast = Cells(Rows.Count, 11).End(xlUp).Row

Workbooks.OpenText Filename:= _
        iPapka4, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd

Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete

 ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
        xlFilterValues, Criteria2:=Array(2, fDate)
        
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy

Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste


Windows(INK4).Activate
ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(INK4).Activate
Windows(INK4).Close

End Sub



 
RADLE, а Вы не в курсе, что свои сообщения можно РЕДАКТИРОВАТЬ?
 
Я могу здесь получить помощь или нет?
 
да, возможно... на этом сайте уже зафиксировано несколько случаев оказания помощи
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
RADLE, можете, но вряд ли получите…вам наплевать на Правила, а нам — на ваши проблемы  ;)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous,  не знал, что в наше время еще остались такие закомплексованные типы на форумах ;)  
 
Цитата
RADLE написал:
остались такие закомплексованные типы
Это называется порядочные. В основном же на форум забегают потреблятели.
 
Очень неудобно в такой портянке разгребаться. Но по сути, самое простое и надежное, это проверять через Dir:
Код
IOK = Dir(odir)
If IOK <> "" then
'блок обработки этого самого IOK
end if
и по сути так со всеми проверяемыми файлами. На примере вот этого куска(не уверен, правда, что правильно все захватил)
Код
Workbooks.OpenText Filename:= _
        iPapka1, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
         
INK = Dir(iPapka)
INK1 = Dir(iPapka1)
INK2 = Dir(iPapka2)
INK3 = Dir(iPapka3)
INK4 = Dir(iPapka4)
             
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd
 
Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete
 
 ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
        xlFilterValues, Criteria2:=Array(2, fDate)
         
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy
 
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK1).Activate
 
ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
 
Windows(INK1).Activate
Windows(INK1).Close
его записать можно так:
Код
If Dir(iPapka1) <> "" then
Workbooks.OpenText Filename:= _
        iPapka1, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
         
INK = Dir(iPapka)
INK1 = Dir(iPapka1)
INK2 = Dir(iPapka2)
INK3 = Dir(iPapka3)
INK4 = Dir(iPapka4)
             
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd
 
Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete
 
 ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
        xlFilterValues, Criteria2:=Array(2, fDate)
         
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy
 
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK1).Activate
 
ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
 
Windows(INK1).Activate
Windows(INK1).Close
end if
Самая сложность здесь, это непонимание происходящего в Вашем коде. А сидеть и разбираться - куча времени, если не знать что там должно происходить. Есть подозрение, что все можно сделать компактнее и правильнее, но....
Потому как если операции всегда одинаковые, то тут массивы с именами файлов и циклы напрашиваются...
Изменено: Дмитрий(The_Prist) Щербаков - 25.01.2021 17:18:49
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков,
Цитата
Дмитрий(The_Prist) Щербаков написал:
о тут массивы с именами файлов и циклы напрашиваются...
такое решение уже предложил New в дубле темы
Не бойтесь совершенства. Вам его не достичь.
 
Дмитрий(The_Prist) Щербаков, да это верный кусок. я пробовал через IF, но в моем коде выдал ошибку типа "не видит блока IF", видимо, я неправильно использую оператор IF несколько раз. Ок, IF iPapka не равно нулю Then открытие и работа с фалом, а если этого фала нет и дальше еще 3 таких куска для трех других файлов через ElseIF и Else у меня тоже не получилось.
Грубо говоря там несколько таких кусков и по сути они одинаковые - просто сначала открывает один файла, форматирует, вставляет в общий. iLast отсчитывает последнюю пустую ячейку в общем, чтобы из следующего файла данный вставлялись под уже вставленные ранее.
Я циклы не очень понимаю, по этому и делаю, как могу. Но представляю, что надо iLast загонять в цикл, другие переменные и названия файлов.  

 
 
Цитата
RADLE написал:
через ElseIF и Else у меня тоже не получилось
а зачем они здесь? Для каждого открываемого файла делаете отдельный IF как я показал и все. Тут не нужны Else. По крайней мере я такой необходимости не вижу.
Совет Вам: если не понимаете принцип работы If и т.п. - изучайте. Благо информации сейчас в интернете много. Тыкать и впихивать конструкции, работу которых не понимаете, не очень хорошая практика.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков, благодарю! Очень простое решение через, как раз для моего уровня. Буду учить и буду стараться правильно публиковать вопросы.  
Страницы: 1
Наверх