Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сбор книг в одну
 
#1
19.04.2022 10:02:49
Есть код, который работает при небольшом количестве строк в книгах
Книга СБ собирает последовательно файлы 1,2,3  лежащие в одной папке
Код
For Each Filename In coll
Set WB = Nothing: Set WB = Workbooks.Open(Filename, False, True)
If WB Is Nothing Then    ' не удалось открыть файл
pi.Log vbTab & "ОШИБКА при загрузке файла. Файл не обработан."
Else    ' файл успешно открыт            
   Set sh = WB.Worksheets("Сбор")
   LastRow = WorksheetFunction.CountIf(sh.Range(sh.Cells(4, 2), sh.Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2)), ">" & 0) + 5            
   Set ra = sh.Range(sh.Range("a4"), sh.Range("b" & LastRow + 1)).Resize(, 36)
   ' ==== переносим данные в наш файл (shd - кодовое имя листа, куда помещаем данные)            
   shd.Range("a" & shd.Rows.Count).End(xlUp).Offset(1).Resize(ra.Rows.Count, ra.Columns.Count).Value = ra.Value            
   WB.Close False: DoEvents    ' закрываем обработанный файл без сохранения изменений
   pi.Log vbTab & "Файл успешно обработан."
End If
Next
Если строк в оригиналах в книге 5000 допустим, то обрабатываются все книги прогресс баром, а результат выгрузка только из первой открытой. Структура оригиналов такая же как и файлы 1,2,3.
Не могу понять в чем причина. подскажите пожалуйста где ошибки
Изменено: Тимофеев - 19.04.2022 10:18:29
 
 
 
#2
19.04.2022 23:06:19
а если определение переменной LastRow искать так?
Код
 LastRow = sh.Cells(sh.Rows.Count, 2).End(xlUp).Row

P.S. Я имею ввиду, попробуйте заменить строку
LastRow = WorksheetFunction.CountIf(sh.Range(sh.Cells(4, 2), sh.Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2)), ">" & 0) + 5            
на вот эту строку
LastRow = sh.Cells(sh.Rows.Count, 2).End(xlUp).Row
Изменено: New - 20.04.2022 00:01:48
 
 
 
#3
20.04.2022 08:09:45
New, не помогло
так работает
Код
For Each Filename In coll
Set WB = Nothing: Set WB = Workbooks.Open(Filename, False, True)
   If WB Is Nothing Then    ' не удалось открыть файл
      pi.Log vbTab & "ОШИБКА при загрузке файла. Файл не обработан."
   Else    ' файл успешно открыт
      Set sh = WB.Worksheets("Сбор")
      lr = Cells(Rows.Count, 1).End(xlUp).Row
         For i = 4 To lr
         If Not IsEmpty(sh.Cells(i, 1)) And sh.Cells(i, 15) <> 0 Then
         If cell Is Nothing Then
            Set cell = sh.Range(sh.Cells(i, 1), sh.Cells(i, 17))
         Else
            Set cell = Union(cell, sh.Range(sh.Cells(i, 1), sh.Cells(i, 17)))
         End If
         End If
         Next i
       If Not cell Is Nothing Then cell.Copy
            shd.Range("a" & shd.Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
            WB.Close False: DoEvents
            pi.Log vbTab & "Файл успешно обработан."
       End If
Set cell = Nothing
Next
Изменено: Тимофеев - 20.04.2022 08:10:17
 
 
 
#4
20.04.2022 08:16:50
Не вдавался в сильные подробности, но вижу нестыковку определения последней ячейки здесь:
LastRow = WorksheetFunction.CountIf(sh.Range(sh.Cells(4, 2), sh.Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2)), ">" & 0) + 5
обратите внимание, что последняя строка определяется на активном листе, но используется для листа sh.
Скорее всего правильно было бы делать так:
Код
LastRow = WorksheetFunction.CountIf(sh.Range(sh.Cells(4, 2), sh.Cells(sh.Cells(sh.Rows.Count, 2).End(xlUp).Row, 2)), ">" & 0) + 5
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#5
20.04.2022 08:25:47
Дмитрий(The_Prist) Щербаков, эта замена так же не помогла
 
 
 
#6
20.04.2022 08:39:37
Можно ТУТ, ТУТ, ТУТ или ТУТ почитать, а ещё ЗДЕСЬ
Изменено: Msi2102 - 20.04.2022 08:41:10
 
 
 
#7
20.04.2022 09:08:23
Цитата
написал:
эта замена так же не помогла
причина проста - у Вас в файлах в столбце В не числа, а числа, записанные как текст. Вам всего лишь надо-то определять последнюю строку без всяких танцев с бубном в виде CountIf. Т.е. вместо этой страшной строки:
Код
LastRow = WorksheetFunction.CountIf(sh.Range(sh.Cells(4, 2), sh.Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2)), ">" & 0) + 5
записываете такую:
Код
LastRow = sh.Cells(sh.Rows.Count, 2).End(xlUp).Row ' добавил
и все будет работать.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#8
20.04.2022 09:12:19
New, это советовал - не помогло пробовал менять там что-то еще намудрил явно
 
 
 
#9
20.04.2022 09:14:26
Цитата
написал:
что-то еще намудрил явно
возможно. На приложенных файлах проверил лично - все работает без проблем.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
Страницы: 1
Наверх