Почему не работает код?

[nilem]

Попробуйте вместо

PHP код:

Do while isnumeric(.cells(iq,4)) 


проверку на пустоту

PHP код:

Do While Not IsEmpty(.Cells(iq, 4)) 


А вообще, примерчик надо.

[EducatedFool]

А вы читаете, что вам предлагают?
В моём коде вы видели слова Integer, Currency и подобные?
Нет? Так уберите их из своего кода.

Мой вариант кода не работает?
Может нам уже хватит гадать, что вы там пытаетесь следать?
Выкладывайте файл, говорите, что надо получить, - и получите нормальный работающий макрос.

[Bogusgl]

Сообщение от EducatedFool

Может нам уже хватит гадать, что вы там пытаетесь следать?
Выкладывайте файл, говорите, что надо получить, - и получите нормальный работающий макрос.

Мне из 1го файла с огромным количеством листов нужно получить еще один лист с отчетом, который должен содержать буквальные и обработанные данные с каждого листа. Хочется завязать все это на кнопку. Не судите строго, я не програмист, я просто ищу пути облегчения работы (((

Сначала был код такой:

Sub Êíîïêà5_Ùåëêíóòü()
Columns(1).ClearContents
Columns(2).ClearContents
Columns(3).ClearContents
Columns(4).ClearContents
Columns(5).ClearContents
Columns(6).ClearContents
Columns(7).ClearContents
Columns(8).ClearContents
Columns(9).ClearContents
Columns(10).ClearContents
Columns(11).ClearContents
Columns(12).ClearContents
Columns(13).ClearContents
Columns(14).ClearContents
Columns(15).ClearContents
Columns(16).ClearContents
Columns(17).ClearContents
Columns(18).ClearContents
Columns(19).ClearContents
Columns(20).ClearContents
Columns(21).ClearContents
Columns(22).ClearContents
Columns(23).ClearContents
Columns(24).ClearContents
Columns(25).ClearContents
Columns(26).ClearContents
Cells(2, 1) = "Sheet"
Cells(2, 2) = "T.Amount1"
Cells(2, 3) = "T.A.2"
Cells(2, 4) = "T.A.3"
Cells(2, 5) = "T.A.4"
Cells(2, 6) = "T.A.5"
Cells(2, 7) = "T.A.6"
Cells(2, 8) = "T.A.7"
Cells(2, 9) = "Sum before tax"
Cells(2, 10) = "Total"
Cells(2, 11) = "Company"
Cells(2, 12) = "The insured"
Cells(2, 13) = "Payee"
Cells(2, 14) = "Date"
Cells(2, 15) = "Contract"
Cells(2, 16) = "Description1"
Cells(2, 17) = "D.2"
Cells(2, 18) = "D.3"
Cells(2, 19) = "D.4"
Cells(2, 20) = "D.5"
Cells(2, 21) = "D.6"
Cells(2, 22) = "D.7"
Cells(2, 23) = "¹¹"

Dim sh As Worksheet, i As Integer
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
        With sh
    If .Index <> ThisWorkbook.ActiveSheet.Index Then
        i = .Index + 1
        Cells(i, 1).Value = .Name
        Cells(i, 2).Value = .[D16]: Cells(i, 3).Value = .[D17]
        Cells(i, 4).Value = .[D18]: Cells(i, 5).Value = .[D19]
        Cells(i, 6).Value = .[D20]: Cells(i, 7).Value = .[D21]
        Cells(i, 8).Value = .[D22]: Cells(i, 13).Value = .[C4]
        Cells(i, 9).Value = .Cells(1, 5)
        Cells(i, 10).Value = .[D22] + .[D21] + .[D20] + .[D19] + .[D18] + .[D17] + .[D16]
        Cells(i, 14).Value = .[C12]: Cells(i, 16).Value = .[C16]
        Cells(i, 17).Value = .[C17]: Cells(i, 18).Value = .[C18]
        Cells(i, 19).Value = .[C19]: Cells(i, 20).Value = .[C20]
        Cells(i, 21).Value = .[C21]: Cells(i, 22).Value = .[C22]
    End If
End With
Next sh
Application.ScreenUpdating = True
Dim iRow As Long
With ActiveSheet.UsedRange
    iRow = .Row + .Rows.Count - 1
End With
Cells(1, 2) = "Âñåãî çàïèñåé:"
Cells(1, 3) = iRow - 2
Dim j As Integer
Dim a1, a2, a3, a4, a5, a6, a7, b1, b2, b3, b4, b5, b6, b7, Sum As Currency
j = 3
     Do
     a1 = 0: a2 = 0: a3 = 0: a4 = 0: a5 = 0: a6 = 0: a7 = 0:
     b1 = 0: b2 = 0: b3 = 0: b4 = 0: b5 = 0: b6 = 0: b7 = 0: Sum = 0
     b1 = Cells(j, 2):     b2 = Cells(j, 3)
     b3 = Cells(j, 4):     b4 = Cells(j, 5)
     b5 = Cells(j, 6):     b6 = Cells(j, 7)
     b7 = Cells(j, 8)
        If b1 > 0 Then a1 = b1 Else a1 = 0
        If b2 > 0 Then a2 = b2 Else a2 = 0
        If b3 > 0 Then a3 = b3 Else a3 = 0
        If b4 > 0 Then a4 = b4 Else a4 = 0
        If b5 > 0 Then a5 = b5 Else a5 = 0
        If b6 > 0 Then a6 = b6 Else a6 = 0
        If b7 > 0 Then a7 = b7 Else a7 = 0
     Sum = a1 + a2 + a3 + a4 + a5 + a6 + a7
       If Sum > 0 Then Cells(j, 9) = Sum Else Cells(j, 8) = Null
        Cells(j, 23) = j - 2
     j = j + 1
     Loop Until j = iRow + 1

End Sub

Но потом оказалось, что "назначений"(см. файл) может быть хоть 300 штук, и теперь я ищу другой путь.

[Bogusgl]

Сообщение от EducatedFool

А вы читаете, что вам предлагают?
В моём коде вы видели слова Integer, Currency и подобные?
Нет? Так уберите их из своего кода.

Мой вариант кода не работает?

Да, он тоже не работает, ругается на эту строку:
xq = Val(.Cells(iq, 4))
Application-defined or object-defined error

[doober]

Вот так не ругается
Привязка у вас есть на активный лист

Sub ЧЧЧ()
Dim sh1 As Worksheet, i, iq, qq As Integer
Dim yq, xq, zq
    Sheets("Лист1").Select
Application.ScreenUpdating = False
xq = 0
yq = 0
zq = 0
iq = 16
For Each sh1 In ThisWorkbook.Worksheets
With sh1
    If .Index <> ThisWorkbook.ActiveSheet.Index Then
        i = .Index + 1
        Do While IsNumeric(.Cells(iq, 4))
           xq = .Cells(iq, 4)
           yq = yq + xq
           iq = iq + 1
           If xq > 0 Then zq = zq + xq Else zq = zq
           xq = 0
         Loop
       Cells(i, 9).Value = yq
       Cells(i, 10).Value = zq
       yq = 0
       zq = 0
     End If
End With
Next sh1
Application.ScreenUpdating = True
End Sub

[Bogusgl]

Сообщение от doober

Вот так не ругается
Привязка у вас есть на активный лист

        Do While IsNumeric(.Cells(iq, 4))

Все ровно сюда ругается!


Блин(((

[IgorGO]

ругнулся: Run-time error '1004': Application-defined or object-defined error, ставим точку останова, запускаем снова, наезжаем курсором на iq и видим iq = 0 не так-ли?

[Bogusgl]

Сообщение от nilem

Попробуйте вместо

PHP код:

Do while isnumeric(.cells(iq,4)) 


проверку на пустоту

PHP код:

Do While Not IsEmpty(.Cells(iq, 4)) 


А вообще, примерчик надо.

Там может не быть пустой ячейки, могут стоять слова...

[IgorGO]

а в ячейке .cells(100 000,4) - может быть пусто?
у Вас так код написан:
для первого листа iq =16, а потом все больше и больше и больше,
isnumeric(для пустой ячейки) = True
iq = 16
For Each sh1 In ThisWorkbook.Worksheets

а может надо так:
For Each sh1 In ThisWorkbook.Worksheets
iq = 16

[Bogusgl]

Сообщение от IgorGO

а может надо так:
For Each sh1 In ThisWorkbook.Worksheets
iq = 16

Вот теперь прям в точку! Все заработало!
Спасибо огромное!