Добрый день! Пишу код, который будет мне из 7-ми разных книг копировать данные (таблицы) в 1 новую книгу. Проблема лишь в том, что подсчёт заполненных строк в каждой книге я ищу путём поиска последней пустой строки. Но в некоторых книгах в таблице есть нулевые строки, но их подряд идёт не больше 5-10 пустых строк за раз. Поэтому определяющим условием конца таблички в книге я хочу определить как 10 подряд пустых строк. И именно в этом выражении кода у меня появляется ошибка (sumCell = sumCell & ActiveWorkbook.Worksheets(t).Cells(i + 1 + s, 1).Value) Ошибка: application-defined or object-defined error. Не пойму в чём дело. Не серчайте на громоздкость и мою неграмотность). [vba]
Код
Application.ScreenUpdating = False
Dim i, i1, i2, t As Long Dim j As Long, n As Long Dim sheet As Worksheet Dim Nazvanie As String Dim Nm(8) As String Dim ShtNm(8) As String Dim NewWB As Workbook Dim s, Ssum As Long
Ssum = 10 'Количество пустых строк определяющее конец листа
Nazvanie = "Общий прайс" 'Вписать название листа, на который будет выводиться информация
For n = 1 To 7 If n = 1 Then k = 1 Else k = 0 End If
Workbooks.Open Nm(n)
For t = 1 To ActiveWorkbook.Worksheets.Count
If ActiveWorkbook.Worksheets(t).Name = ShtNm(n) Then i = 2 - k Do i = i + 1
If IsEmpty(ActiveWorkbook.Worksheets(t).Cells(i + 1, 1)) = True Then
For s = 0 To Ssum 'ищем выражение, образованное соединением значений 10 ячеек, следующих после i-й ячейки sumCell = sumCell & ActiveWorkbook.Worksheets(t).Cells(i + 1 + s, 1).Value Next s End If
Loop While Not sumCell = "0" 'поднимаем номер строки до тех пор, пока выражение из 10 строк не будет равно "" sumCell = "0" j = 21
i1 = 0 Do i1 = i1 + 1
Loop While Not IsEmpty(NewWB.Worksheets(1).Cells(i1, 1)) = True ActiveWorkbook.Worksheets(t).Cells(2 - k, 1).Resize(i, 21).Copy NewWB.Worksheets(1).Cells(i1, 1)
End If
Next t
Next n
i1 = 1 Do i1 = i1 + 1 Loop While Not IsEmpty(NewWB.Worksheets(1).Cells(i1, 1)) = True
NewWB.Activate ActiveWorkbook.Worksheets(1).Cells(1, 1).Resize(i1, 21).Select Selection.RowHeight = 15 With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With
Application.DisplayAlerts = False NewWB.SaveAs Filename:=pathNB & "1_" & nameNWB Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba]
Добрый день! Пишу код, который будет мне из 7-ми разных книг копировать данные (таблицы) в 1 новую книгу. Проблема лишь в том, что подсчёт заполненных строк в каждой книге я ищу путём поиска последней пустой строки. Но в некоторых книгах в таблице есть нулевые строки, но их подряд идёт не больше 5-10 пустых строк за раз. Поэтому определяющим условием конца таблички в книге я хочу определить как 10 подряд пустых строк. И именно в этом выражении кода у меня появляется ошибка (sumCell = sumCell & ActiveWorkbook.Worksheets(t).Cells(i + 1 + s, 1).Value) Ошибка: application-defined or object-defined error. Не пойму в чём дело. Не серчайте на громоздкость и мою неграмотность). [vba]
Код
Application.ScreenUpdating = False
Dim i, i1, i2, t As Long Dim j As Long, n As Long Dim sheet As Worksheet Dim Nazvanie As String Dim Nm(8) As String Dim ShtNm(8) As String Dim NewWB As Workbook Dim s, Ssum As Long
Ssum = 10 'Количество пустых строк определяющее конец листа
Nazvanie = "Общий прайс" 'Вписать название листа, на который будет выводиться информация
For n = 1 To 7 If n = 1 Then k = 1 Else k = 0 End If
Workbooks.Open Nm(n)
For t = 1 To ActiveWorkbook.Worksheets.Count
If ActiveWorkbook.Worksheets(t).Name = ShtNm(n) Then i = 2 - k Do i = i + 1
If IsEmpty(ActiveWorkbook.Worksheets(t).Cells(i + 1, 1)) = True Then
For s = 0 To Ssum 'ищем выражение, образованное соединением значений 10 ячеек, следующих после i-й ячейки sumCell = sumCell & ActiveWorkbook.Worksheets(t).Cells(i + 1 + s, 1).Value Next s End If
Loop While Not sumCell = "0" 'поднимаем номер строки до тех пор, пока выражение из 10 строк не будет равно "" sumCell = "0" j = 21
i1 = 0 Do i1 = i1 + 1
Loop While Not IsEmpty(NewWB.Worksheets(1).Cells(i1, 1)) = True ActiveWorkbook.Worksheets(t).Cells(2 - k, 1).Resize(i, 21).Copy NewWB.Worksheets(1).Cells(i1, 1)
End If
Next t
Next n
i1 = 1 Do i1 = i1 + 1 Loop While Not IsEmpty(NewWB.Worksheets(1).Cells(i1, 1)) = True
NewWB.Activate ActiveWorkbook.Worksheets(1).Cells(1, 1).Resize(i1, 21).Select Selection.RowHeight = 15 With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With
Application.DisplayAlerts = False NewWB.SaveAs Filename:=pathNB & "1_" & nameNWB Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Ищите не сверху вниз, а снизу (от последней строки) вверх [vba]
Код
r_=range("A" & rows.Count).end(xlUp).row
[/vba] Это аналогично тому, как если бы Вы встали в полследнюю ячейку столбца А и нажали бы Контрл + Стрелка_вверх. Номер строки той ячейки, в которой Вы оказались бы, и будет r_
Ищите не сверху вниз, а снизу (от последней строки) вверх [vba]
Код
r_=range("A" & rows.Count).end(xlUp).row
[/vba] Это аналогично тому, как если бы Вы встали в полследнюю ячейку столбца А и нажали бы Контрл + Стрелка_вверх. Номер строки той ячейки, в которой Вы оказались бы, и будет r__Boroda_
_Boroda_, Плин, точно! Но в моём случае непонятно всё-таки, чем вызвана ошибка. И можно ли делать так: [vba]
Код
For s = 0 To Ssum 'ищем выражение, образованное соединением значений 10 ячеек, следующих после i-й ячейки sumCell = sumCell & ActiveWorkbook.Worksheets(t).Cells(i + 1 + s, 1).Value Next s
[/vba]
_Boroda_, Плин, точно! Но в моём случае непонятно всё-таки, чем вызвана ошибка. И можно ли делать так: [vba]
Код
For s = 0 To Ssum 'ищем выражение, образованное соединением значений 10 ячеек, следующих после i-й ячейки sumCell = sumCell & ActiveWorkbook.Worksheets(t).Cells(i + 1 + s, 1).Value Next s