Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/цикл перебора ячеек вниз по столбцу - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » цикл перебора ячеек вниз по столбцу (макрос)
цикл перебора ячеек вниз по столбцу
nimr Дата: Понедельник, 12.02.2018, 10:41 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте.
Необходимо сделать цикл перебора ячеек в столбце, содержащих даты, до нахождения отличной от предыдущей(их).
Параллельно с датами в соседних двух столбцах находятся цифры, суммы которых (за пройденный циклом день) нужно сложить.
Похожая, на мой взгляд, задача была решена AlexM.
Я не смог понять , казалось бы, элементарное неравенство, которое AlexM пишет во втором цикле.
Немного изменив его,
        While Range("A" & iRow) - DateSerial(Year(Range("A" & iRow + 1)), Month(Range("A" & iRow + 1)), Day(Range("A" & iRow + 1))) > 0
получил ошибку о несовпадении данных.
Остальное, вроде бы, не вызывает трудностей понимания, хотя отладчиком дойти до (нужного) завершения не получилось.
Код его великолепен. Но моих знаний не хватает, чтобы, воспользовавшись исходником, править его под свою задачу.
Файл нужен для дальнейшей распечатки. Данных много. Листов - от 15
Данные приходят с разными датами.
Цитата AlexM, 17.01.2013 в 19:20, в сообщении № 5 ()
Код макроса
Sub Macros()
Application.ScreenUpdating = False
iRow = 2
While Range("A" & iRow) <> ""
    If Range("F" & iRow) = "-" Then Range("G" & iRow) = "-"
    If Range("F" & iRow) <> "-" Then
        While Range("F" & iRow) - DateSerial(Year(Range("E" & iRow)), Month(Range("E" & iRow)) + 1, Day(Range("E" & iRow))) > 0
            Rows(iRow).Copy: Rows(iRow + 1).Insert Shift:=xlDown: Application.CutCopyMode = False
            Range("G" & iRow) = "-"
            Range("E" & iRow + 1) = DateSerial(Year(Range("E" & iRow)), Month(Range("E" & iRow)) + 1, Day(Range("E" & iRow)))
            Range("A" & iRow) = iRow - 1
            Range("A" & iRow + 1) = iRow
            iRow = iRow + 1
        Wend
        Range("G" & iRow) = Range("F" & iRow)
    End If
Range("A" & iRow) = iRow - 1
iRow = iRow + 1
Wend
Application.ScreenUpdating = True
End Sub

См. файл.

PS. Оптимизацией кода заниматься некогда, сегодня погода и лыжня классная.


К сообщению приложен файл: 5418561.xls (21.0 Kb)
 
Ответить
СообщениеЗдравствуйте.
Необходимо сделать цикл перебора ячеек в столбце, содержащих даты, до нахождения отличной от предыдущей(их).
Параллельно с датами в соседних двух столбцах находятся цифры, суммы которых (за пройденный циклом день) нужно сложить.
Похожая, на мой взгляд, задача была решена AlexM.
Я не смог понять , казалось бы, элементарное неравенство, которое AlexM пишет во втором цикле.
Немного изменив его,
        While Range("A" & iRow) - DateSerial(Year(Range("A" & iRow + 1)), Month(Range("A" & iRow + 1)), Day(Range("A" & iRow + 1))) > 0
получил ошибку о несовпадении данных.
Остальное, вроде бы, не вызывает трудностей понимания, хотя отладчиком дойти до (нужного) завершения не получилось.
Код его великолепен. Но моих знаний не хватает, чтобы, воспользовавшись исходником, править его под свою задачу.
Файл нужен для дальнейшей распечатки. Данных много. Листов - от 15
Данные приходят с разными датами.
Цитата AlexM, 17.01.2013 в 19:20, в сообщении № 5 ()
Код макроса
Sub Macros()
Application.ScreenUpdating = False
iRow = 2
While Range("A" & iRow) <> ""
    If Range("F" & iRow) = "-" Then Range("G" & iRow) = "-"
    If Range("F" & iRow) <> "-" Then
        While Range("F" & iRow) - DateSerial(Year(Range("E" & iRow)), Month(Range("E" & iRow)) + 1, Day(Range("E" & iRow))) > 0
            Rows(iRow).Copy: Rows(iRow + 1).Insert Shift:=xlDown: Application.CutCopyMode = False
            Range("G" & iRow) = "-"
            Range("E" & iRow + 1) = DateSerial(Year(Range("E" & iRow)), Month(Range("E" & iRow)) + 1, Day(Range("E" & iRow)))
            Range("A" & iRow) = iRow - 1
            Range("A" & iRow + 1) = iRow
            iRow = iRow + 1
        Wend
        Range("G" & iRow) = Range("F" & iRow)
    End If
Range("A" & iRow) = iRow - 1
iRow = iRow + 1
Wend
Application.ScreenUpdating = True
End Sub

См. файл.

PS. Оптимизацией кода заниматься некогда, сегодня погода и лыжня классная.


Автор - nimr
Дата добавления - 12.02.2018 в 10:41
sboy Дата: Понедельник, 12.02.2018, 10:46 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Нарисуйте в файле как должен выглядеть результат.

Яндекс: 410016850021169
 
Ответить
СообщениеДобрый день.
Нарисуйте в файле как должен выглядеть результат.
Автор - sboy
Дата добавления - 12.02.2018 в 10:46
nimr Дата: Понедельник, 12.02.2018, 11:07 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Рисую. Суммы за день. Прикладываю.
upd: добрый день. Извините, пожалуйста.
К сообщению приложен файл: 2248523.xls (23.0 Kb)


Сообщение отредактировал nimr - Понедельник, 12.02.2018, 11:08
 
Ответить
СообщениеРисую. Суммы за день. Прикладываю.
upd: добрый день. Извините, пожалуйста.
Автор - nimr
Дата добавления - 12.02.2018 в 11:07
sboy Дата: Понедельник, 12.02.2018, 11:39 | Сообщение № 4
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Можно вот изменить.
[vba]
Код
Sub Macros()
Application.ScreenUpdating = False
iRow = 3
While Range("A" & iRow) <> ""
    sumD = Range("C" & iRow)
    sumK = Range("D" & iRow)
        While Range("A" & iRow) = Range("A" & iRow + 1)
            sumD = sumD + Range("C" & iRow + 1)
            sumK = sumK + Range("D" & iRow + 1)
            iRow = iRow + 1
        Wend
        iRow = iRow + 1
        Rows(iRow).Insert xlShiftDown
        Range("C" & iRow) = sumD
        Range("D" & iRow) = sumK
iRow = iRow + 1
Wend
Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 3307130.xls (36.0 Kb)

Яндекс: 410016850021169
 
Ответить
СообщениеМожно вот изменить.
[vba]
Код
Sub Macros()
Application.ScreenUpdating = False
iRow = 3
While Range("A" & iRow) <> ""
    sumD = Range("C" & iRow)
    sumK = Range("D" & iRow)
        While Range("A" & iRow) = Range("A" & iRow + 1)
            sumD = sumD + Range("C" & iRow + 1)
            sumK = sumK + Range("D" & iRow + 1)
            iRow = iRow + 1
        Wend
        iRow = iRow + 1
        Rows(iRow).Insert xlShiftDown
        Range("C" & iRow) = sumD
        Range("D" & iRow) = sumK
iRow = iRow + 1
Wend
Application.ScreenUpdating = True
End Sub
[/vba]
Автор - sboy
Дата добавления - 12.02.2018 в 11:39
nimr Дата: Понедельник, 12.02.2018, 21:01 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Спасибо вам,sboy. Сейчас стану испытывать.
 
Ответить
СообщениеСпасибо вам,sboy. Сейчас стану испытывать.
Автор - nimr
Дата добавления - 12.02.2018 в 21:01
nimr Дата: Понедельник, 12.02.2018, 22:06 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Всё понял, sboy. Хитро как. Опыта нет, конечно. И в мыслях даже не было так сделать. Спасибо. Порядковые номера сделаю сам.
upd: Опыта у меня нет, конечно. И в мыслях даже не было так сделать. Спасибо. Порядковые номера сделаю сам.


Сообщение отредактировал nimr - Понедельник, 12.02.2018, 22:30
 
Ответить
СообщениеВсё понял, sboy. Хитро как. Опыта нет, конечно. И в мыслях даже не было так сделать. Спасибо. Порядковые номера сделаю сам.
upd: Опыта у меня нет, конечно. И в мыслях даже не было так сделать. Спасибо. Порядковые номера сделаю сам.
Автор - nimr
Дата добавления - 12.02.2018 в 22:06
nimr Дата: Вторник, 13.02.2018, 11:41 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
[vba]
Код
Sub Macros()
Application.ScreenUpdating = False
iRow = 3
Dim a As Integer
a = 1
While Range("A" & iRow) <> ""
sumD = Range("C" & iRow)
sumK = Range("D" & iRow)
While Range("A" & iRow) = Range("A" & iRow + 1)
Range("B" & iRow) = a
sumD = sumD + Range("C" & iRow + 1)
sumK = sumK + Range("D" & iRow + 1)
iRow = iRow + 1
a = a + 1
Wend
Range("B" & iRow) = a
iRow = iRow + 1
Rows(iRow).Insert xlShiftDown
Range("C" & iRow) = sumD
Range("D" & iRow) = sumK
iRow = iRow + 1
a = 1
Wend
Application.ScreenUpdating = True
End Sub
[/vba] вот так можно ли оформлять счётчик в решении (моей задачи, решённой by sboy) или это слишком громоздко и есть какой-то стандартный ход для облегчения кода? Пожалуйста, выскажите своё мнение, необходимое мне для продолжения освоения VBA и написания более коротких и быстрых макросов.

И ещё. Каким-то непонятным образом в результате (Е9) нули отсутствуют, а во всех остальных -- они зачем-то есть. Мне они не нужны. Что заставляет их не появляться?
upd:18:35 в дальнейшем решении (моей задачи, уже практически решённой by sboy)


Сообщение отредактировал nimr - Вторник, 13.02.2018, 18:36
 
Ответить
Сообщение[vba]
Код
Sub Macros()
Application.ScreenUpdating = False
iRow = 3
Dim a As Integer
a = 1
While Range("A" & iRow) <> ""
sumD = Range("C" & iRow)
sumK = Range("D" & iRow)
While Range("A" & iRow) = Range("A" & iRow + 1)
Range("B" & iRow) = a
sumD = sumD + Range("C" & iRow + 1)
sumK = sumK + Range("D" & iRow + 1)
iRow = iRow + 1
a = a + 1
Wend
Range("B" & iRow) = a
iRow = iRow + 1
Rows(iRow).Insert xlShiftDown
Range("C" & iRow) = sumD
Range("D" & iRow) = sumK
iRow = iRow + 1
a = 1
Wend
Application.ScreenUpdating = True
End Sub
[/vba] вот так можно ли оформлять счётчик в решении (моей задачи, решённой by sboy) или это слишком громоздко и есть какой-то стандартный ход для облегчения кода? Пожалуйста, выскажите своё мнение, необходимое мне для продолжения освоения VBA и написания более коротких и быстрых макросов.

И ещё. Каким-то непонятным образом в результате (Е9) нули отсутствуют, а во всех остальных -- они зачем-то есть. Мне они не нужны. Что заставляет их не появляться?
upd:18:35 в дальнейшем решении (моей задачи, уже практически решённой by sboy)
Автор - nimr
Дата добавления - 13.02.2018 в 11:41
Мир MS Excel » Вопросы и решения » Вопросы по VBA » цикл перебора ячеек вниз по столбцу (макрос)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!