Динамические диапазоны промежуточных итогов в VBA Excel не работают - PullRequest
Новая
       21

Динамические диапазоны промежуточных итогов в VBA Excel не работают

0 голосов
/ 04 февраля 2019

У меня есть этот фрагмент кода, который я позаимствовал из другого поста и отредактировал (или, по крайней мере, попробовал), который я пытаюсь использовать для подведения итогов некоторых динамических диапазонов.Я использую ключевой столбец с 0, 1 и 2.Я хочу, чтобы код добавил все соответствующие столбцы напротив каждого 1, пока он не достигнет 2, а затем поместил промежуточный итог в столбец с 2. В настоящее время мой код продолжает работать в обратном направлении, поэтому он вводит неправильные промежуточные итоги. Ниже приведенфрагмент моего кода. 

'count all 1's in each section till next 2 for subtotaling each section
With Range("P13:P" & lRow1)
Set rFind = .Find(What:=2, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                  Lookat:=xlWhole, SearchDirection:=xlNext, searchFormat:=False)
If Not rFind Is Nothing Then
    s = rFind.Address
    Do
        Set r1 = rFind
        Set rFind = .FindNext(rFind)
        If rFind.Address = s Then
            Set rFind = .Cells(.Cells.Count)
            r1.Offset(, -5).Value = Application.Sum(Range(r1.Offset(-1, -5), r1.Offset(, -5)))
            Exit Sub
        End If
        r1.Offset(, -5).Value = Application.Sum(Range(r1.Offset(-1, -5), rFind.Offset(, -5)))
    Loop While rFind.Address <> s
End If
End With

Даже сейчас, когда я набираю этот вопрос, я думаю, что должен использовать другой подход.Мой код помещает 0 в каждую пустую строку, и в настоящее время он настроен на размещение 0 в строке выше 1-го 1. С этим я мог бы найти 1-й 0, затем добавить все 1, пока я не достигну 2, затем найтиследующий 0 и так далее.Имеет ли это смысл?

Ниже приведено изображение того, что макрос в настоящее время производит.

Snippet of Macro Output

1 Ответ

0 голосов
/ 04 февраля 2019

Вы можете фактически сделать это с формулой

=IF(P3=2,SUMIF($P$1:P2,1,$K$1:K2)-SUMIF($P$1:P2,2,$K$1:K2),"")

в каждой ячейке в K, где есть 2 в столбце P. Можно использовать VBA, чтобы вставить это.

enter image description here

Вот прямое решение VBA: 

Sub x()

Dim r As Range

For Each r In Range("K:K").SpecialCells(xlCellTypeConstants).Areas
    r(r.Count + 1).Value = Application.Sum(r)
Next r

End Sub
...