Страницы: 1 2 След.
RSS
Суммирование ячеек определенного столбца выделенной таблицы начиная с 3 строки.
 
Добрый день.

Именно такой темы я не нашла, где-то что-то частично, но собрать во едино все в рабочий макрос не могу. А может и не стоит, может можно сделать проще?

Итак, задача:
есть файл с разными таблицами, т.е. таблицы с разными категориями расходов и разными категориями доходов. Количество этих таблиц и количество строк каждый раз меняются, т.е. могут добавляться несколько таблиц (или только строки в имеющихся таблицах) если есть такие расходы или доходы, а может их и не быть вовсе. т.е. привязать к определенным ячейкам функцию СУММ не могу. НО не меняются количество столбцов и названия колонок в каждой таблице. Помимо строки с заголовком, в каждой таблице имеется строка с нумерацией столбца, т.е. записывая диапазон сумирующихся ячеек в столбце, не включать сюда первые 2 строки выделенной таблицы.
мне нужно посчитать сумму всех расходов и доходов по категориям, вывести результат по каждой категории и баланс, т.е. сумму всех расходов отнять от суммы всех доходов.

что я смогла сделать - это посчитать категорию расходов которые имеют код состоящий из 5- 6 цифр, т.е. зацепилась за код и столбец. использовала функцию =СУММЕСЛИМН(E:E;B:B;">11110";B:B;"<30000")

найти нужную таблицу по определенному слову и выделить ее
Код
Sub услуги()
' Сочетание клавиш: Ctrl+k

   Cells.Find(What:="Электричество", After:=ActiveCell, LookIn:=xlValues, _
       LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
       MatchCase:=False, SearchFormat:=False).Activate
End Sub

Код
Sub Макрос1()
' Сочетание клавиш: Ctrl+l

   Selection.CurrentRegion.Select
End Sub

посчитать сумму ячеек которые находятся выше выделенной ячейки (выделяю вручную)
Код
Sub Summ2()
Dim x
 x = ActiveCell.Offset(-1).End(xlUp).Row
 ActiveCell.FormulaR1C1 = "=SUM(R" & x & "C:R[-1]C)"
End Sub

но этот макрос считает вместе со 2 строкой, которая содержит нумерацию столбцов.
 
Так?
Код
ActiveCell.FormulaR1C1 = "=SUM(R3C:R[-1]C)"
 
Эта команда привязывается к 3 строке листа, а мне нужно привязать ее к выделенной таблице. как я сказала, таблиц много и расположение их разное. эта команда считает все значения в столбце начиная с 3 строки до выделенной ячейки.

Спасибо, но не совсем то что мне нужно.
 
Цитата
нужно привязать ее к выделенной таблице
Нужен пример, чтоб понять, как определить границы таблицы.
 
таких таблиц может быть много
 
Код
Sub Summ2()
    Dim y As Long
    Dim x  As Integer
    x = ActiveCell.Column
    'Определение верхней границы ячейки по цвету заливки.
    For y = ActiveCell.Row To 1 Step -1
        Select Case Cells(y, x).Interior.Color
        Case 16777215
            Exit For
        End Select
    Next
    
    'Поиск третьей строки с учётом объединённых ячеек.
    y = y + 1
    Dim i As Byte
    For i = 1 To 2
        y = y + Cells(y, x).MergeArea.Rows.Count
    Next
    
    ActiveCell.FormulaR1C1 = "=SUM(R" & y & "C:R[-1]C)"
End Sub
 
cпасибо, за попытку помочь.
однако, работает только со 2 таблицей из примера, а если добавить строк, то не работает. считает данные только из последних (нижних) строк.
 
Странно это. У меня работает со всеми таблицами в файле из сообщения #5. И после добавления строк работает корректно.
Можете по шагам описать, что вы делаете?
Например:
Выделяю ячейку E6.
Запускаю макрос Summ2.
В результате получаю формулу "=..." в ячейке E6.
 
Код
Sub Summ2()
    If ActiveCell.Row > 1 Then
        Dim y As Long
        Dim x  As Integer
        x = ActiveCell.Column
        'Определение верхней границы ячейки по цвету заливки.
        For y = ActiveCell.Row - 1 To 1 Step -1
            Select Case Cells(y, x).Interior.Color
            Case 16777215
                Exit For
            End Select
        Next
         
        'Поиск третьей строки с учётом объединённых ячеек.
        y = y + 1
        Dim i As Byte
        For i = 1 To 2
            y = y + Cells(y, x).MergeArea.Rows.Count
        Next
         
        ActiveCell.FormulaR1C1 = "=SUM(R" & y & "C:R[-1]C)"
    End If
End Sub
 
Это все здорово, но я не учла одного - эти таблицы я вырезала из рабочего файла. ОН ВЕСЬ СЕРЫЙ.  В примере макрос работает а в рабочем файле не везде.
Может определить верхнюю границу ячейки по названию заголовка (или по слову из заголовка) столбца?
 
Этот вариант считает границей строку, в которой содержится "№ стр.".
Можно дописать несколько искомых значений. Поиск идёт по всей строке листе.
Добавилась опция: можно выделить несколько ячеек, формула проставится в каждую из них.
Код
Sub Summ2()
    Dim bExit As Boolean
    Dim y As Long
    Dim i As Byte
    Dim x  As Integer
    x = ActiveCell.Column
    
    y = ActiveCell.Row - 1
    Do
        If WorksheetFunction.CountIfs(Rows(y), "№ стр.") > 0 Then
            bExit = True
        ElseIf WorksheetFunction.CountIfs(Rows(y), "№ стр.1") > 0 Then
            bExit = True
        '---------------------------------------------------------------
        'Этот блок скопировать и вставить значение, по которому будет определяться первая строка таблицы.
        ElseIf WorksheetFunction.CountIfs(Rows(y), "№ стр.2") > 0 Then
            bExit = True
        '---------------------------------------------------------------
        End If
        
        If bExit Then
            For i = 1 To 3
                y = y + Cells(y, x).MergeArea.Rows.Count
            Next
        
            Selection.FormulaR1C1 = "=SUM(R" & y & "C:R[-1]C)"
            Exit Do
        End If
        
        If y = 1 Then Exit Do
        y = y - 1
    Loop
    
End Sub
 
  Что-то не то выходит
Запускаю макрос Summ2.
В результате получаю формулу
Код
=СУММ(P10:P$13) 
в ячейке P11. Ячейку таблицы нашел, но не то посчитал и не там вывел.
Если говорить о 2ой таблице, то он должен посчитать диапазон E14:E19 и ответ вывести в Q3
Если говорить о 3ой таблице, то он должен посчитать диапазон D25 и ниже если еще есть заполненные строки и ответ вывести в R3

и еще не понимаю, почему он не считает 1 и 3 таблицы они же тоже содержат "№ стр." ?
 
Код
Sub Summ2()
    Dim bExit As Boolean
    Dim y As Long
    Dim i As Byte
    Dim x  As Integer
    x = ActiveCell.Column
     
    y = ActiveCell.Row - 1
    Do
        If WorksheetFunction.CountIfs(Rows(y), "№ стр.") > 0 Then
            bExit = True
        ElseIf WorksheetFunction.CountIfs(Rows(y), "№ стр.1") > 0 Then
            bExit = True
        '---------------------------------------------------------------
        'Этот блок скопировать и вставить значение, по которому будет определяться первая строка таблицы.
        ElseIf WorksheetFunction.CountIfs(Rows(y), "№ стр.2") > 0 Then
            bExit = True
        '---------------------------------------------------------------
        End If
         
        If bExit Then
            For i = 1 To 2
                y = y + Cells(y, x).MergeArea.Rows.Count
            Next
         
            Selection.FormulaR1C1 = "=SUM(R" & y & "C:R[-1]C)"
            Exit Do
        End If
         
        If y = 1 Then Exit Do
        y = y - 1
    Loop
     
End Sub
Что-то я упустил. А когда появилась третья строка?
Цитата
ALEXANDRA MMM написал:
и ответ вывести в Q3
Раньше было озвучено, что нужно считать с 3 строки таблицы до выделенной ячейки.

И сообщение, видимо, модераторам. Куда-то делось сообщение, в котором автор указывал, какую ячейку выделяет. Было между сообщениями, которые сейчас пронумерованы как #8 и #9.
 
1) "Раньше было озвучено, что нужно считать с 3 строки таблицы до выделенной ячейки."

Именно так я и говорила: 3 строки таблицы . потом я заметила что некоторые заголовки столбцов состоят из нескольких строк. там где надо я изменяла с 3ей на 4ю, где-то в 2ом вашем макросе, и все работало.
(кажется в этой строке
Код
If bExit Then
            For i = 1 To 2

заменила с 2 на 3)

2) Ответ мне нужен в 3 строке листа, т.к. в файле могут быть и 800- 900 строк, и искать результаты по всему листу и собирать во едино будет много вр. отнимать.

3) Когда вставляю искомое слово в скрипт, макрос это слово находит и заменяет на сумму вышестоящих ячеек.
например:
Код
ElseIf WorksheetFunction.CountIfs(Rows(y), "расходы") > 0 Then
            bExit = True

выделяется ячейка D10, где ранее было слово "расходы", макрос слово это заменил на формулу "=СУММ(D$4:D9)".
 
Так будет выводить в строку 3.
Код
Sub Summ2()
    Dim bExit As Boolean
    Dim y As Long
    Dim i As Byte
    Dim x  As Integer
    x = ActiveCell.Column
     
    y = ActiveCell.Row - 1
    Do
        If WorksheetFunction.CountIfs(Rows(y), "№ стр.") > 0 Then
            bExit = True
        ElseIf WorksheetFunction.CountIfs(Rows(y), "№ стр.1") > 0 Then
            bExit = True
        '---------------------------------------------------------------
        'Этот блок скопировать и вставить значение, по которому будет определяться первая строка таблицы.
        ElseIf WorksheetFunction.CountIfs(Rows(y), "№ стр.2") > 0 Then
            bExit = True
        '---------------------------------------------------------------
        End If
         
        If bExit Then
            For i = 1 To 2
                y = y + Cells(y, x).MergeArea.Rows.Count
            Next
         
            If y > 3 Then
                If ActiveCell.Row > 1 Then
                    Cells(3, ActiveCell.Column).FormulaR1C1 = "=SUM(R" & y & "C:R" & ActiveCell.Row - 1 & "C)"
                End If
            End If
            Exit Do
        End If
         
        If y = 1 Then Exit Do
        y = y - 1
    Loop
     
End Sub
Мне одному кажется странным, cначала написать "Вывести формулу в выделенную ячейку" (#1 ActiveCell.FormulaR1C1 =), потом написать, что макрос не туда выводит, и только потом написать, куда макрос должен выводить?  Not necessary reply.
 
ок, с  местом вывода результата разобрались.

объясните плиз, что у вас выходит, когда вы активируете этот макрос, по шагам, с формулой?
допустим искомое слово таблицы расходы.
 
Например, выделяю ячейку D30 в прикреплённом файле.
Запускаю макрос.
В ячейке D3 появляется формула "=СУММ(D$23:D$29)".
 
Аааа, так все-таки надо вручную выделить ячейку под колонкой, которую надо посчитать!
ясно.
А можно вас еще помучить? =) ну, чтоб усовершенствовать мою задумку с макросом

и я обратила внимание в макросе пример 2 в 17 сообщении, вы искомое слово вставили в if-строку,
Код
If WorksheetFunction.CountIfs(Rows(y), "расходы") > 0 Then
            bExit = True

а я согласно, комментарию в строке со словом ElseIf

'Этот блок скопировать и вставить значение, по которому будет определяться первая строка таблицы.        
Код
ElseIf WorksheetFunction.CountIfs(Rows(y), "№ стр.2") > 0 Then
            bExit = True

кстати за что отвечает эта строка?
Код
ElseIf WorksheetFunction.CountIfs(Rows(y), "№ стр.1") > 0 Then
 
 
Вы правильно поняли, как использовать эти строки. Не срабатывало из-за выделения не той ячейки.
Эти строки можно копировать столько раз, сколько Вам нужно. Вместо строки "№ стр.1" вставьте значения, по которым будет выполняться поиск, например, "расходы".  
 
Так я продолжу (с вашей помощью) с усовершенствованием макроса? Вы не сказали нет :)

Поколдуйте, плиз, чтобы этот макрос сам нашел ячейку, куда вставить формулу.
Возможно сделать так:
1) собрать мои первые 2 макроса и ваш, так чтобы при запуске макрос:
  1. находил искомое слово,
  2. выделял всю таблицу в которой находится это слово,
  3. считал данные из столбца выделенного диапазона - 2 строки
  4. выводил результат под этой же колонкой таблицы
  5. и этот же результат копировал в ячейку Q3
1.1 а чтобы он нашел суммируемый диапазон, добавить сюда условие - суммируемый диапазон находится в столбце на 2 столбца правее от ячейки с искомым словом и там где заканчивается выделенный диапазон этого столбца, т.е. от верхнего края выделенной таблицы + 1 строка и до нижнего края выделенной таблицы.
1.2. ввести формулу СУММ в ячейку которая находится (не ругайтесь) под выделенным столбцом.

Cейчас объясню почему прошу снова выводить результат под суммируемой колонкой таблицы. Потому что, как я сказала, таблиц много и находятся они в одних и тех же столбцах, и результат из нижних таблиц записывается поверх результата верхних таблиц т.к. любые результаты записываются в том же столбце, что и суммируемый диапазон, в 3 строке файла. Я попробовала изменить конечную ячейку на Q3, но тогда получалась ерунда: суммировались данные из столбца Q.

Вот как-то так :)
Изменено: vikttur - 31.07.2021 23:09:21
 
Цитата
ALEXANDRA MMM написал:  Вы не сказали нет
А правила форума что говорят?
Вопрос не по теме. И это уже тянет на полноценное ТЗ для платного раздела )
Изменено: vikttur - 31.07.2021 23:10:11
 
ок. правила почитала до конца.

ну можно хотя бы помочь еще с  пунктом 1.1 и 1.2  сообщения 20?
Изменено: ALEXANDRA MMM - 02.08.2021 00:47:47
 
Может использовать

Range("расходы").Offset(1,3).Activate  ?

если да то как и куда?
 
Цитата
ALEXANDRA MMM написал:
собрать мои первые 2 макроса
Код
Sub Summ3()
    Dim r As Range
    On Error Resume Next
    Set r = Cells.Find("расходы")
    On Error GoTo 0
    If r Is Nothing Then
        MsgBox "Не найдены расходы.", vbExclamation
    Else
        Dim r2 As Range
        Set r2 = Intersect(r.EntireColumn, r.CurrentRegion)
        If r2.Rows.Count > 3 Then
            Set r2 = r2.Resize(r2.Rows.Count - 3)
            Set r2 = r2.Offset(3, 2)
            With r2
                Cells(3, .Column).FormulaR1C1 = "=SUM(" & .Address(1, 1, xlR1C1) & ")"
                Cells(.Row + .Rows.Count, .Column).FormulaR1C1 = "=SUM(" & .Address(1, 1, xlR1C1) & ")"
            End With
        End If
    End If
End Sub
 
супер!!!
вроде работает.
а если в файле несколько таблиц,  которые содержат искомое слово, макрос находит только первую таблицу, а к остальным не применяется? а можно сделать чтобы он ко всем по очереди применялся по щелчку "ентер"?
Изменено: ALEXANDRA MMM - 02.08.2021 14:21:43
 
Цитата
ALEXANDRA MMM написал:
где менять значения, если суммируемый диапазон смещается по отношению к искомому слову?
Менять нужно тут.
Код
Set r2 = r2.Offset(3, 2)
3 в этой строке это смещение по строкам.
2 - смещение по столбцам.
Если меняете смещение по строкам, то ещё менять нужно тут:
Код
Set r2 = r2.Resize(r2.Rows.Count - 3)
Цитата
ALEXANDRA MMM написал:
если в файле несколько таблиц,  которые содержат искомое слово, макрос находит только первую таблицу, а к остальным не применяется?
Да.
 
а можно сделать чтобы он ко всем по очереди применялся по щелчку "ентер"?
 
что тут надо менять если сместился диапазон на 1 строку вниз? вместо -3 напечатать -4?

Set r2 = r2.Resize(r2.Rows.Count - 3)
 
Код
Sub Summ3()
    Dim r As Range
    Set r = Cells.Find("расходы", , , xlWhole)
    If Not r Is Nothing Then
        Dim firstAddress As String
        firstAddress = r.Address
        Dim r2 As Range
        Dim y As Long
        Dim n As Long
        Dim i As Byte
        Dim x As Integer
        Do
            If r Is Nothing Then Exit Do
            y = r.Row
            x = r.Column
            n = -1
            For i = 1 To 3
                n = n + Cells(y, x).MergeArea.Rows.Count
                y = y + Cells(y, x).MergeArea.Rows.Count
            Next
            
            Set r2 = Intersect(r.EntireColumn, r.CurrentRegion)
            If r2.Rows.Count > n Then
                Set r2 = r2.Resize(r2.Rows.Count - n)
                Set r2 = r2.Offset(n, 2)
                Application.Goto r2
                With r2
                    Select Case MsgBox(r2.Address(0, 0), vbQuestion + vbYesNo, "Применить к диапазону?")
                    Case vbYes
                        Cells(3, .Column).FormulaR1C1 = "=SUM(" & .Address(1, 1, xlR1C1) & ")"
                        Cells(.Row + .Rows.Count, .Column).FormulaR1C1 = "=SUM(" & .Address(1, 1, xlR1C1) & ")"
                    End Select
                End With
            End If
    
            Set r = Cells.FindNext(r)
            If r.Address = firstAddress Then Exit Do
        Loop
    End If
End Sub
 
Цитата
ALEXANDRA MMM написал:
что тут надо менять если сместился диапазон на 1 строку вниз? вместо -3 напечатать -4?
Поменять тройку тут
Код
For i = 1 To 3
Страницы: 1 2 След.
Наверх