Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Расчет через цикл в цикле (for - next)
 
#1
28.06.2016 15:31:53
Доброго времени суток! Недавно начал заниматься с vba, так что с трудными задачами возникают большие трудности.
В 1 колонке дата, в 11 сумма, в 12 сумма, в 14 дата, которую надо заполнить. Необходимо, найти в колонке 12 сумму больше либо равно сумме в 11 и записать дату из найденной строки (колонка 1) в исходную строку в колонке 14. И так для каждого значения в колонке 11.

Вот мой код, в которому сразу есть какая-то ошибка, не очень понимаю, как исправить, возможно, что он вообще не заработает.
Код
Dim k As Integer, l As Integer, m As Date
    Set R = Range(Cells(2, 12), Cells(LastRow, 12))
    For i = 2 To LastRow Step 1
        For l = 2 To LastRow Step 1
            If l1.Cells(i, 11) <= R(l) Then
            k = R(l).Row
            GoTo cont
        Next l
cont:
    m = l1.Cells(k, 1)
    l1.Cells(i, 14).Value = m
    Next i
Изменено: Boris05036 - 28.06.2016 16:09:08
 
 
 
#2
28.06.2016 15:57:16
1. Название темы плохое: сюда можно какие угодно вопросы по циклам поместить. Предложите новое, раскрывающее суть проблемы, а не название инструмента, при помощи которого Вы планируете это осуществить. Модераторы поменяют.
2. Код следует оформлять соответствующим тегом. Ищите такую кнопку и исправьте своё сообщение.
 
 
 
#3
28.06.2016 16:02:01
Юрий М, можно назвать "Расчет через цикл в цикле (for)"
 
 
 
#4
28.06.2016 16:37:13
1 - про ошибку написано в сообщении
---------------------------
Microsoft Visual Basic for Applications
---------------------------
Compile error:

Next without For
---------------------------
OK   Help  
---------------------------

но обычно оно так пишет и когда не хватает End If

2 - не вижу значения lastrow
3 - возможно integer маловато - кто знает, файла нет, задача не видна...
Изменено: Hugo - 28.06.2016 16:41:32
 
 
 
#5
28.06.2016 16:41:42
Hugo,
1 - точно, про end if совсем забыл, когда писал равенство, сейчас посмотрю, работает ли сам расчет

2-3 - 4тыс с строк в данном случае, на другие операции хватает, тут же цикл вообще не запускается, выдает ошибку по next l (next without for), если убрать, то то же самое с next i

Ошибку не выдает, но не работает... везде посчитал 0... может как изменить надо?
Изменено: Boris05036 - 28.06.2016 16:51:41
 
 
 
#6
28.06.2016 17:23:25
У Вас Hugo, спросил, чему равно lastrow ?
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
28.06.2016 17:25:39
Sanja,я ответил, что 4тыс, этого достаточно, другие циклы попроще считает, тут я ошибся в чем-то

дополнительно
Код
Dim LastRow As Long
    
    LastRow = Sheets("l1").Cells(Rows.Count, 1).End(xlUp).Row
Изменено: Boris05036 - 28.06.2016 17:27:45
 
 
 
#8
28.06.2016 17:28:02
Цитата
Hugo написал:
файла нет, задача не видна...
Файл в студию.
Изменено: Бахтиёр - 28.06.2016 17:29:32
 
 
 
#9
28.06.2016 17:29:07
 без файла, можно только гадать, что у Вас там не клеится
Изменено: Sanja - 28.06.2016 17:31:02
Согласие есть продукт при полном непротивлении сторон
 
 
 
#10
28.06.2016 17:46:02
Бахтиёр, Hugo, Sanja, спасибо за отзывчивость, скидываю сокращенную версию, которую могу показать
 
 
 
#11
28.06.2016 17:46:07
пока писал, файл приложили. Можно удалить
Изменено: Sanja - 28.06.2016 17:47:18
Согласие есть продукт при полном непротивлении сторон
 
 
 
#12
28.06.2016 17:53:15
1. нет значения у k, т.е. оно 0
2. лучше перенести код в стандартный модуль - из книги бывают необъяснимые глюки...
 
 
 
#13
28.06.2016 17:56:19
Hugo, так неправильно задавать?
Код
If card62.Cells(i, 11) <= R(l) Then
            k = R(l).Row
 
 
 
#14
28.06.2016 17:59:57
Не в том дело - при первом обращении к этой переменной она 0, что вызывает ошибку. Правьте логику, мне сейчас некогда вникать, домой собираюсь.
 
 
 
#15
28.06.2016 18:08:42
Такие вещи лучше на массивах делать (а то и на коллекциях)
Если я правильно представляю конечный результат, попробуйте так
Код
Sub calculate_()
Dim lRow As Long, I As Integer
Application.ScreenUpdating = False
    With Sheets("l1")
        .Columns("A:A").NumberFormat = "DD.MM.YYYY"
        .Columns("N:N").NumberFormat = "DD.MM.YYYY"
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr1 = .Range("K2:K" & lRow).Value
        arr2 = .Range("L2:L" & lRow).Value
        For I = LBound(arr1) To UBound(arr1)
            For J = LBound(arr2) To UBound(arr2)
                If arr2(J, 1) >= arr1(I, 1) Then .Cells(J + 1, 14) = .Cells(I + 1, 1)
            Next
        Next
    End With
Application.ScreenUpdating = True
End Sub
Изменено: Sanja - 28.06.2016 18:10:29
Согласие есть продукт при полном непротивлении сторон
 
 
 
#16
28.06.2016 18:08:56
Hugo, спасибо, поставил end if после совета... да не там... goto снаружи оказалось, плюс переместил в модуль из листа и все заработало на большом объеме данных, ровно как моя огромадная формула, только в vba проще оказалось реализовать
 
 
 
#17
28.06.2016 18:09:57
Sanja, спасибо, завтра тоже попробую и ваш вариант, может он заработает и окажется быстрее

Посмотрел, все то же самое, подход понятен, спасибо, мне больше привычен просто другой, хотя не знаю, сыграет ли роль на скорости выполнения при тысячах 8-10 строк
Изменено: Boris05036 - 28.06.2016 19:47:43
 
 
 
#18
28.06.2016 21:05:07
Цитата
Boris05036 написал: сыграет ли роль на скорости выполнения при тысячах 8-10 строк
Разница будет точно, но на хорошем железе можете не заметить, миллисекунды.
Согласие есть продукт при полном непротивлении сторон
 
 
 
#19
28.06.2016 22:05:28
Разница должна быть раз так в 45, если ещё и изменения делать через массив.
Помню аналогично с 40 минут ускорил до 5 секунд, и это ещё без словарей!
 
 
 
#20
29.06.2016 07:54:37
Исходный код с исправлениями
Код
Dim k As Integer, l As Integer, m As Date, R
LastRow = 4000
Set l1 = ActiveSheet '= Worksheets("Лист1")
With l1
    Set R = Range(.Cells(2, 12), .Cells(LastRow, 12))
    For i = 2 To LastRow Step 1
        k = LastRow + 1
        For l = 2 To LastRow Step 1
            If .Cells(i, 11) <= R(l) Then 
               k = R(l).Row
               Exit For
            End If
        Next l
    m = .Cells(k, 1)
    .Cells(i, 14).Value = m
    Next i
End With
Изменено: TheBestOfTheBest - 29.06.2016 07:54:42
Неизлечимых болезней нет, есть неизлечимые люди.
 
 
 
Страницы: 1
Наверх