Грешка 1004 в цикъл на сумиране с динамични граници (също бавно)

Нов съм в VBA и се занимавам със сума, която включва три if цикъла. Кодът изглежда така

Dim strKonto As String
Dim str?r As String
Dim strUdbetaling As String
Dim counter As Integer
Dim yearkbottom As Integer
Dim yearktop As Integer


For i = 1 To 50 'wsRefor.Cells(Rows.Count, 2).End(xlUp).Row
    For k = 1 To 20 '200
        yearkbottom = (wsRefor.Cells(k + 3, 1) - 2007) + 1
        yearktop = (yearkbottom - 2007) + 4000

        For j = yearkbottom To yearktop

            strKonto = Right(wsArk7.Cells(j + 4, 2), 4)
            str?r = wsArk7.Cells(j + 4, 1)
            strUdbetaling = Left(wsArk7.Cells(j + 4, 2), 1)
            counter = Val(str?r) - 2007

            If wsRefor.Cells(i + 1, 2) = strKonto Then
                If wsRefor.Cells(1, k + 3) = str?r Then
                    If strUdbetaling = 2 Then
                        wsRefor.Cells(i + 1, k + 3) = wsRefor.Cells(i + 1, k + 3) + wsArk7.Cells(j + 4, k + 2 - counter * 12)
                    End If
                End If
            End If
        Next j
    Next k
Next i

За j-цикъла се опитах да направя границите динамични, за да направя изчисленията малко по-бавни. Тоест, сигурен съм, че всички стойности, които j цикълът намира, не са разпространени в целия диапазон от j, а по-скоро в диапазона, дефиниран по-горе с помощта на k.

Въпреки това, когато правя тази промяна, получавам 1004 „Грешка, дефинирана от приложение или дефинирана от обект“.

Някой може ли да забележи грешката или алтернативно да предложи някакви методи за ускоряване на сумата?

Най-добри,

ID

EDIT: Разбрах какъв е проблема. Броячът j стана нула в някакъв момент от новите граници и когато това се случи (или когато е отрицателен), грешката, която получих, се появява.

Благодаря за помощта!


sum vba
person pkpkPPkafa    schedule 09.08.2016    source източник
comment
На кой ред код получавате тази грешка?   -  person Siva    schedule 09.08.2016
comment
Честно казано не съм сигурен. Почти съм сигурен, че идва на някой от трите реда, който започва с yearkbottom = (wsRefor.Cells(k + 3, 1) - 2007) + 1 и завършва с For j = yearkbottom To yearktop   -  person pkpkPPkafa    schedule 09.08.2016
comment
Как да отстранявате грешки в VBA код -- След като се покаже грешката, трябва да се маркира ред с жълта лента. Това е редът за грешка.   -  person Andre    schedule 09.08.2016
comment
@pkpkPPkafa имаш Dim str?r As String, моят VB редактор крещи, когато видя str?r, това типична грешка ли е?   -  person Shai Rado    schedule 09.08.2016
comment
@ShaiRado , това са само неанглийски букви, така че не се тревожи за това. Проверих кода и той работи добре, ако коментирам трите реда, които споменах, и вместо това вмъкна 1 до 1000 за j границите.   -  person pkpkPPkafa    schedule 09.08.2016
comment
@pkpkPPkafa Отстранете грешки в кода, както е предложено от Андре. Изпълних кода, който ми дадохте, с примерни данни. Виждам, че работи добре. Така че предполагам, че нещо не е наред с вашите входни данни, които идват от „wsRefor“   -  person Siva    schedule 09.08.2016
comment
@pkpkPPkafa, Моля, вижте, че всеки път, когато стойността j се превърне в 0 или отрицателна стойност, този цикъл хвърля грешката, която сте посочили   -  person Siva    schedule 09.08.2016
comment
Благодаря за това. Разбрах защо е нула, защото бях направил грешка във формулата на клетките в първия от трите реда. Благодаря @Siva. Това е толкова мило от ваша страна :-)   -  person pkpkPPkafa    schedule 09.08.2016
comment
Винаги си добре дошъл!!! Всичко най-хубаво!!!   -  person Siva    schedule 09.08.2016
comment
@Сива. Сега поправих кода и вече не получавам проблема. Така че благодаря Въпреки това (!), сега VBA спира да отговаря всеки път, когато стартирам кода. i цикли през ~50 obs k цикли през ~140 obs j цикли през ~4000 obs Наборът просто голям ли е? Същото се случва, ако напиша всички i,j,k граници в твърдо кодирано число, така че динамиката не е проблемът.   -  person pkpkPPkafa    schedule 09.08.2016
comment
Вероятно поради примките. Вашият код трябва да изпълни 50*140*4000 итерации. Всеки път, когато се повтори, той взаимодейства с Excel листове. Възможно е това да са някои от причините. Моля, намерете тази връзка и вижте дали ще ви помогне, да видим дали можете да опитате нещо друго. blogs.office.com/2009/03 /12/   -  person Siva    schedule 09.08.2016
comment
Благодаря. Изглежда, че може да има нещо в настройката на данните в масиви. Въпреки това нямам опит с поставянето на данни в масиви. Знаете ли как да го направите или знаете ръководство за това?   -  person pkpkPPkafa    schedule 09.08.2016
comment
Ще го пробвам от своя страна и ще споделя кода. Имайте предвид, че можете да търсите масиви във vba и тяхното използване   -  person Siva    schedule 09.08.2016
comment
@Siva Cool. Благодаря. Разгледах го малко преди и се опитах да направя определената колона j в масив (все още динамичен за всяко k, както в кода по-горе). Въпреки това не мога да накарам кода да се изпълни. Предполагам, че не знам как да направя диапазон правилно. Опитах да направя нещо като (Range((yearkbottom, k + 2 - counter * 12),(yearktop, k + 2 - counter * 12)), но получавам съобщение за грешка   -  person pkpkPPkafa    schedule 09.08.2016
comment
Добавено е още едно решение чрез фина настройка на някои от областите. Надяваме се, че ще ви помогне   -  person Siva    schedule 09.08.2016

Отговори (1)


arrow_upward
0
arrow_downward

Опитайте по-долу един. Опитах се да направя някои фини настройки.

Dim strKonto As String
Dim strr As String
Dim strUdbetaling As String
Dim counter As Integer
Dim yearkbottom As Integer
Dim yearktop As Integer

Dim arryearkbottom(20) 'Declaring a Static Array of Size 21,(Starts from 0 index)
Dim arryearktop(20) 'Declaring a Static Array of Size 21,(Starts from 0 index)

'Initial Values
screenUpdateState = Application.ScreenUpdating

statusBarState = Application.DisplayStatusBar

calcState = Application.Calculation

eventsState = Application.EnableEvents

'Turning off the values for performance
Application.ScreenUpdating = False

Application.DisplayStatusBar = False

Application.Calculation = xlCalculationManual

Application.EnableEvents = False

'Reading all the values from sheet to Arrays
For i = 1 To 20
    arryearkbottom(i) = (wsRefor.Cells(i + 3, 1) - 2007) + 1
    arryearktop(i) = (arryearkbottom(i) - 2007) + 4000

Next


For i = 1 To 50 'wsRefor.Cells(Rows.Count, 2).End(xlUp).Row
    For k = 1 To 20 '200
        'yearkbottom = (wsRefor.Cells(k + 3, 1) - 2007) + 1
        'yearktop = (yearkbottom - 2007) + 4000
         For j = arryearkbottom(k) To arryearktop(k)

            strKonto = Right(wsArk7.Cells(j + 4, 2), 4)
            strr = wsArk7.Cells(j + 4, 1)
            strUdbetaling = Left(wsArk7.Cells(j + 4, 2), 1)
            counter = Val(strr) - 2007

            If wsRefor.Cells(i + 1, 2) = strKonto Then
                If wsRefor.Cells(1, k + 3) = strr Then
                    If strUdbetaling = 2 Then
                        wsRefor.Cells(i + 1, k + 3) = wsRefor.Cells(i + 1, k + 3) + wsArk7.Cells(j + 4, k + 2 - counter * 12)
                    End If
                End If
            End If
        Next j
    Next k
Next i


'Setting to Initial values
Application.ScreenUpdating = screenUpdateState

Application.DisplayStatusBar = statusBarState

Application.Calculation = calcState

Application.EnableEvents = eventsState

Решение 2:

Dim strKonto As String
Dim strr As String
Dim strUdbetaling As String
Dim counter As Integer
Dim yearkbottom As Integer
Dim yearktop As Integer
Dim rngwsRefor As Range
Dim rngwsArk7 As Range

'Initial Values
screenUpdateState = Application.ScreenUpdating
statusBarState = Application.DisplayStatusBar
calcState = Application.Calculation
eventsState = Application.EnableEvents

'Turning off the values for performance
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'Reading Entire sheet values to range
Set rngwsRefor = wsRefor.Cells
Set rngwsArk7 = wsArk7.Cells


For i = 1 To 50 'wsRefor.Cells(Rows.Count, 2).End(xlUp).Row
    For k = 1 To 20 '200
        yearkbottom = (rngwsRefor(k + 3, 1).Value - 2007) + 1
        yearktop = (yearkbottom - 2007) + 4000
         For j = yearkbottom To yearktop

            strKonto = Right(rngwsArk7(j + 4, 2).Value, 4)
            strr = rngwsArk7(j + 4, 1).Value
            strUdbetaling = Left(rngwsArk7(j + 4, 2).Value, 1)
            counter = Val(strr) - 2007

            If rngwsRefor(i + 1, 2).Value = strKonto Then
                If rngwsRefor(1, k + 3).Value = strr Then
                    If strUdbetaling = 2 Then
                        rngwsRefor(i + 1, k + 3).Value = rngwsRefor(i + 1, k + 3).Value + rngwsArk7.Cells(j + 4, k + 2 - counter * 12).Value
                    End If
                End If
            End If
        Next j
    Next k
Next i


'Setting to Initial values
Application.ScreenUpdating = screenUpdateState
Application.DisplayStatusBar = statusBarState
Application.Calculation = calcState
Application.EnableEvents = eventsState
person Siva    schedule 09.08.2016