сканирование листов в Vba

405

05 апреля 2005 года

Dmitrii

554 / / 16.12.2004

Цитата:

Originally posted by Maks555
имеется следующая програмка:

Sub Report()
Dim curSheet As Worksheet
Dim curRow, targetRow As Integer
targetRow = 1
'Цикл по всем листам книги
For Each curSheet In Workbooks("Книга1").Worksheets
If curSheet.Name <> "Отчет" Then
curSheet.Activate
For curRow = 1 To 10
If IsNumeric(Cells(curRow, 8 ).Value) And Cells(curRow, 8 ).Value <> Empty Then
Worksheets("Отчет").Cells(targetRow, 1 ).Value = Cells(curRow, 8 ).Value
Worksheets("Отчет").Cells(targetRow, 2 ).Value = Cells(curRow, 1 ).Value
Worksheets("Отчет").Cells(targetRow, 3 ).Value = Cells(curRow, 2 ).Value
targetRow = targetRow + 1
End If
Next curRow
End If
Next curSheet
Worksheets("Отчет").Activate
End Sub

как сделать чтобы сканирование листов происходило в определенном диапазоне. Например с 5 до 50.

Sub Report()
Dim curSheet As Worksheet
Dim curRow, targetRow As Integer
targetRow = 1
For curSheet = 5 To 50
If Worksheets(curSheet).Name <> "Отчет" Then
Worksheets(curSheet).Activate
For curRow = 1 To 10
If IsNumeric(Cells(curRow, 8 ).Value) And Cells(curRow, 8 ).Value <> Empty Then
Worksheets("Отчет").Cells(targetRow, 1 ).Value = Cells(curRow, 8 ).Value
Worksheets("Отчет").Cells(targetRow, 2 ).Value = Cells(curRow, 1 ).Value
Worksheets("Отчет").Cells(targetRow, 3 ).Value = Cells(curRow, 2 ).Value
targetRow = targetRow + 1
End If
Next curRow
End If
Next curSheet
Worksheets("Отчет").Activate
End Sub

5.9K

05 апреля 2005 года

24 / / 04.02.2005

Цитата:

Originally posted by Dmitrii
Sub Report()
Dim curSheet As Worksheet
Dim curRow, targetRow As Integer
targetRow = 1
[COLOR=blue]вылазит ошибка "type mismatch" >>>[/COLOR] For curSheet = 5 To 50
[COLOR=blue] действительно ли нужно это условие?>>>[/COLOR] If Worksheets(curSheet).Name <> "Отчет" Then
Worksheets(curSheet).Activate
For curRow = 1 To 10
If IsNumeric(Cells(curRow, 8 ).Value) And Cells(curRow, 8 ).Value <> Empty Then
Worksheets("Отчет").Cells(targetRow, 1 ).Value = Cells(curRow, 8 ).Value
Worksheets("Отчет").Cells(targetRow, 2 ).Value = Cells(curRow, 1 ).Value
Worksheets("Отчет").Cells(targetRow, 3 ).Value = Cells(curRow, 2 ).Value
targetRow = targetRow + 1
End If
Next curRow
End If
Next curSheet
Worksheets("Отчет").Activate
End Sub

275

05 апреля 2005 года

985 / / 19.09.2004

Sub Report()
Dim curSheet As Worksheet
Dim curRow, targetRow As Integer
targetRow = 1
For curSheet = 5 To 50

Исправленный код не должен работать в принципе, так как в новом варианте переменная curSheet должна быть типа Integer, a не Worksheet

P.S. IMHO - можно обойтись и без выделения (активации) рабочих листов.

5.9K

05 апреля 2005 года

24 / / 04.02.2005

вот и я тоже пробовал вылазит не совпадение типов. А как тогда сделать без активации листов?
Заранее благодарен.

405

05 апреля 2005 года

Dmitrii

554 / / 16.12.2004

Цитата:

Originally posted by pashulka
Sub Report()
Dim curSheet As Worksheet
Dim curRow, targetRow As Integer
targetRow = 1
For curSheet = 5 To 50

Исправленный код не должен работать в принципе, так как в новом варианте переменная curSheet должна быть типа Integer, a не Worksheet

P.S. IMHO - можно обойтись и без выделения (активации) рабочих листов.

Совершенно верно.
Виноват, забыл исправить Dim curSheet As Worksheet на Dim curSheet As Integer.

Цитата:

Originally posted by Maks555
А как тогда сделать без активации листов?

Без активации можно так:
If IsNumeric(Worksheets(curSheet).Cells(curRow, 1).Value) And Worksheets(curSheet).Cells(curRow, 1).Value <> Empty Then
Worksheets("Отчет").Cells(targetRow, 1).Value = Worksheets(curSheet).Cells(curRow, 8 ).Value
Worksheets("Отчет").Cells(targetRow, 2).Value = Worksheets(curSheet).Cells(curRow, 1).Value
Worksheets("Отчет").Cells(targetRow, 3).Value = Worksheets(curSheet).Cells(curRow, 2).Value
targetRow = targetRow + 1
End If

По поводу необходимости условия If Worksheets(curSheet).Name <> "Отчет".
Это Вам решать. Если в диапазон сканируемых листов точно не попадёт лист "Отчёт", то - не нужно, а если такой гарантии нет, то лучше оставить, иначе этот лист тоже будет обработан, как и прочие.

275

05 апреля 2005 года

985 / / 19.09.2004

Насчёт проверки, IMHO - 100% лучше оставить, так как судя по коду этот рабочий лист наличествует в рабочей книги и даже если сейчас он не входит в диапазон рабочих листов с 5 по 50, то нет никакой гарантии, что это не произойдёт через некоторое количество времени. IMHO - я бы ещё добавил проверку на наличие этого рабочего листа, проверку количества рабочих листов, мало ли что ...

Вот мой вариант, без активации :

Свернуть исходник

Код:

Sub Report()

Set iCells1 = Worksheets("Отчет").Cells

For curSheet = 5 To 50

Set iCells2 = Worksheets(curSheet).Cells

If iCells2.Parent.Name <> "Отчет" Then

For curRow = 1 To 10

If IsNumeric(iCells2(curRow, 8).Value) And iCells2(curRow, 8).Value <> "" Then

   targetRow = targetRow + 1

   iCells1(targetRow, 1).Value = iCells2(curRow, 8).Value

   iCells1(targetRow, 2).Value = iCells2(curRow, 1).Value

   iCells1(targetRow, 3).Value = iCells2(curRow, 2).Value

End If

Next

End If

Next

End Sub

5.9K

05 апреля 2005 года

24 / / 04.02.2005

Большое спасибо за ответ. Число листов постоянное. Лан проверку оставлю на всякий случай.

275

05 апреля 2005 года

985 / / 19.09.2004

P.S.
Цитата : вот и я тоже пробовал вылазит не совпадение типов (Maks555)

Я не проверял отредактированную версию, только ознакомился визуально.

5.9K

05 апреля 2005 года

24 / / 04.02.2005

Цитата:

Originally posted by pashulka
P.S.
Цитата : вот и я тоже пробовал вылазит не совпадение типов (Maks555)

Я не проверял отредактированную версию, только ознакомился визуально.

Все отлично работает спасибо еще раз!

Только у меня есть еще одна проблемка. В одной из страниц есть ошибка в формуле "#ссылка!" и при компеляции до ходя до этого места програмка останавливается и вылазит ошибка.
Можно ли как нибудь сделать проверку на эту ошибку, чтобы эта ячейка просто пропускалась.

405

05 апреля 2005 года

Dmitrii

554 / / 16.12.2004

Цитата:

Originally posted by Maks555
Все отлично работает спасибо еще раз!

Только у меня есть еще одна проблемка. В одной из страниц есть ошибка в формуле "#ссылка!" и при компеляции до ходя до этого места програмка останавливается и вылазит ошибка.
Можно ли как нибудь сделать проверку на эту ошибку, чтобы эта ячейка просто пропускалась.

Попробуйте так:
If Not (IsError(Cells(curRow, 8 ))) Then
If IsNumeric(...) And ... Then
...
End If
End If

275

05 апреля 2005 года

985 / / 19.09.2004

При желании можно убрать лишние скобки, т.е. :

Код:

If Not IsError(iCells2(curRow, 8).Value) Then

If IsNumeric(iCells2(curRow, 8).Value) And iCells2(curRow, 8).Value <> "" Then

   '''

End If

End If

P.S. Откуда взялась "#ссылка!" и не хотите ли Вы это исправить ...