Здравствуйте. Помогите ,пожалуйста,создать код.Пример во вложении.Суть такова.В столбце "Т" ищем последнюю заполненную ячейку.В столбце "В" ищем первую заполненную ячейку.В этом диапазоне идем по столбцу "Н". Если в ячейках "Сумма" , тогда суммируем ячейки в диапазоне "А:А" - "Т:Т" и сумму вставлям под последней заполненной ячейкой (столбце "Т").Заранее благодарю за оказанную помощь.
Здравствуйте. Помогите ,пожалуйста,создать код.Пример во вложении.Суть такова.В столбце "Т" ищем последнюю заполненную ячейку.В столбце "В" ищем первую заполненную ячейку.В этом диапазоне идем по столбцу "Н". Если в ячейках "Сумма" , тогда суммируем ячейки в диапазоне "А:А" - "Т:Т" и сумму вставлям под последней заполненной ячейкой (столбце "Т").Заранее благодарю за оказанную помощь.Amator
Sub tt() r0_ = Cells(Rows.Count, 2).End(3).Row r1_ = Cells(Rows.Count, 8).End(3).Row With Cells(r1_ + 1, 9).Resize(1, 12) .FormulaR1C1 = "=SUM(R4C:R9C)/2" .Value = .Value End With End Sub
[/vba]
Так нужно? [vba]
Код
Sub tt() r0_ = Cells(Rows.Count, 2).End(3).Row r1_ = Cells(Rows.Count, 8).End(3).Row With Cells(r1_ + 1, 9).Resize(1, 12) .FormulaR1C1 = "=SUM(R4C:R9C)/2" .Value = .Value End With End Sub
Я понял так: общая сумма по строке вставляется в столбец Т в строку ниже [vba]
Код
Sub Summ_() Dim dSum As Double Dim lRwS As Long, lRwF As Long Dim i As Long, j As Long With Worksheets("Пример") lRwS = .Cells(.Rows.Count, 2).End(xlUp).Row lRwF = .Cells(.Rows.Count, 8).End(xlUp).Row Application.ScreenUpdating = False
For i = lRwS To lRwF If .Cells(i, 8).Value = "Сумма" Then dSum = 0
For j = 9 To 20 dSum = dSum + .Cells(i, j).Value Next j
.Cells(i + 1, 20).Value = dSum End If Next i End With
Application.ScreenUpdating = True End Sub
[/vba]
Я понял так: общая сумма по строке вставляется в столбец Т в строку ниже [vba]
Код
Sub Summ_() Dim dSum As Double Dim lRwS As Long, lRwF As Long Dim i As Long, j As Long With Worksheets("Пример") lRwS = .Cells(.Rows.Count, 2).End(xlUp).Row lRwF = .Cells(.Rows.Count, 8).End(xlUp).Row Application.ScreenUpdating = False
For i = lRwS To lRwF If .Cells(i, 8).Value = "Сумма" Then dSum = 0
For j = 9 To 20 dSum = dSum + .Cells(i, j).Value Next j
.Cells(i + 1, 20).Value = dSum End If Next i End With
Немного изменил файл.В данном файле одна запись , которая добавлена из формы.После добавления записи на лист нужно просуммировать строки если в диапазоне "Н:Н" - "Сумма". После суммирования будет введена следующая запись, которую также нужно суммировать и т.д.
Немного изменил файл.В данном файле одна запись , которая добавлена из формы.После добавления записи на лист нужно просуммировать строки если в диапазоне "Н:Н" - "Сумма". После суммирования будет введена следующая запись, которую также нужно суммировать и т.д.Amator
Мой код не подходит? Вы проверяли? Проверьте Можно еще добавить надпись "Итого" [vba]
Код
Sub tt() r0_ = Cells(Rows.Count, 2).End(3).Row r1_ = Cells(Rows.Count, 8).End(3).Row With Cells(r1_ + 1, 9).Resize(1, 12) .FormulaR1C1 = "=SUM(R4C:R9C)/2" .Value = .Value .Range("A1").Offset(, -1) = "Итого:" End With End Sub
[/vba]
Мой код не подходит? Вы проверяли? Проверьте Можно еще добавить надпись "Итого" [vba]
Код
Sub tt() r0_ = Cells(Rows.Count, 2).End(3).Row r1_ = Cells(Rows.Count, 8).End(3).Row With Cells(r1_ + 1, 9).Resize(1, 12) .FormulaR1C1 = "=SUM(R4C:R9C)/2" .Value = .Value .Range("A1").Offset(, -1) = "Итого:" End With End Sub
общая сумма по столбцам вставляется в строку ниже последней заполненной
Подправил: [vba]
Код
Sub Summ_() Dim aSum(1 To 12) Dim lRwS As Long, lRwF As Long Dim i As Long, j As Long With Worksheets("Пример") lRwS = .Cells(.Rows.Count, 2).End(xlUp).Row lRwF = .Cells(.Rows.Count, 8).End(xlUp).Row Application.ScreenUpdating = False
For i = lRwS To lRwF If .Cells(i, 8).Value = "Сумма" Then For j = 9 To 20 aSum(j - 8) = aSum(j - 8) + .Cells(i, j).Value Next j End If Next i
.Cells(lRwF + 1, 9).Resize(1, 12).Value = aSum End With
Application.ScreenUpdating = True End Sub
[/vba]
Цитата
общая сумма по столбцам вставляется в строку ниже последней заполненной
Подправил: [vba]
Код
Sub Summ_() Dim aSum(1 To 12) Dim lRwS As Long, lRwF As Long Dim i As Long, j As Long With Worksheets("Пример") lRwS = .Cells(.Rows.Count, 2).End(xlUp).Row lRwF = .Cells(.Rows.Count, 8).End(xlUp).Row Application.ScreenUpdating = False
For i = lRwS To lRwF If .Cells(i, 8).Value = "Сумма" Then For j = 9 To 20 aSum(j - 8) = aSum(j - 8) + .Cells(i, j).Value Next j End If Next i
.Cells(lRwF + 1, 9).Resize(1, 12).Value = aSum End With
_Boroda_, В данном случае работает , но строк может быть гораздо больше . в том числе с ячейкой "Сумма" . Необходимо прикрутить условие "если Ячейка (i, 8) = "Сумма".Спасибо.
_Boroda_, В данном случае работает , но строк может быть гораздо больше . в том числе с ячейкой "Сумма" . Необходимо прикрутить условие "если Ячейка (i, 8) = "Сумма".Спасибо.Amator
Отключение обновления экрана было нужно, когда шла работа с ячейками. Сейчас строки с Application.ScreenUpdating можно убрать - при одновременной разовой записи в нескольких ячеек эффекта не дает. Или поставить их там, где они должны быть: [vba]
Код
.............. Application.ScreenUpdating = False .Cells(lRwF + 1, 9).Resize(1, 12).Value = aSum Application.ScreenUpdating = True End With End Sub
[/vba]
Отключение обновления экрана было нужно, когда шла работа с ячейками. Сейчас строки с Application.ScreenUpdating можно убрать - при одновременной разовой записи в нескольких ячеек эффекта не дает. Или поставить их там, где они должны быть: [vba]
Код
.............. Application.ScreenUpdating = False .Cells(lRwF + 1, 9).Resize(1, 12).Value = aSum Application.ScreenUpdating = True End With End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
