VBA：加入了不規則的範圍

Question

傢伙嗨，

我一直在使用＃1幾個月，並且通常，我設法找到直到現在我所有的VBA挑戰的解決方案：

我需要一些幫助來創建一個宏，這個宏在E列之間的列E上添加了所有值，並用「avg」字。結果應該顯示在顯示「Sum here」標籤的單元格上。 「avg」和「sum here」這兩個文本僅用於舉例說明，「avg」可以替換爲任何其他單詞，「sum here」實際上應該是其上面值的聚合。

真正的挑戰是，範圍在E列的數量是可變的，所以我想找到一個宏，它能夠應付在列E.範圍內的「n」個

最後，列D上的值只是「總計在此」單元上的期望值的示例。

這是我曾嘗試遠：

 Sub Macro1() 
' 
' Macro1 Macro 
' 
Dim sumhere As Range 
Dim startingpoint As Range 
Dim endingpoint As Range 

' 
    Range("C17").Select 
    Selection.End(xlDown).Select 
    If ActiveCell = "avg" Then 
     ActiveCell.Offset(rowoffset:=0, columnoffset:=2).Select 


     Set sumhere = ActiveCell 
     Set startingpoint = ActiveCell.Offset(rowoffset:=-1, columnoffset:=0) 


     Selection.End(xlUp).Select 
     If (ActiveCell.Value) = "Sum here" Then 
     Set endingpoint = ActiveCell.Offset(rowoffset:=1, columnoffset:=0) 
     sumhere.Formula = "=sum(range(startingpoint:endingpoint)" 



     Else 
     Selection.End(xlUp).Select 
     If (ActiveCell.Value) = "Sum here" Then 
     Set endingpoint = ActiveCell.Offset(rowoffset:=1, columnoffset:=0) 
     sumhere.Formula = "=Sum(Range(startingpoint.adress:endingpoint.adress))" 


     Else: End If 
     End If 

    End If 

End Sub 

另外，你可以看到，我不知道如何使用變量定義範圍。我最初的想法是將此代碼與某種「do while」或/和「for i = 1 to x」和「next i」結合起來......但我看不出如何合併它。

非常感謝你！

Answer 1

當然，你只需要像：

Sub sums() 
Dim i As Integer, j As Integer, k As Integer 

j = Range("C1048576").End(xlUp).Row 
k = 1 

For i = 1 To j 
    If Range("C" & i).Value <> "" Then 
     Range("E" & i).Value = "=Sum(E" & k & ":E" & i - 1 & ")" 
     k = i + 1 
    End If 
Next i 

End Sub 

Answer 2

只使用公式，並提供每個小計行的列A只有avg（或任何文本）。

我給出了公式的兩個版本 - 易失版本（每次更改電子表格中的任何內容時更新）以及非易失版本（只在需要時才更新）。

應在第6行輸入公式 - 將$E6更改爲您需要的行。

（揮發性）

=SUM(OFFSET($E6,IFERROR(LOOKUP(2,1/($A$1:INDEX($A:$A,ROW()-1)<>""),ROW($A$1:INDEX($A:$A,ROW()-1))),0)-ROW()+1,,ROW()-1-IFERROR(LOOKUP(2,1/($A$1:INDEX($A:$A,ROW()-1)<>""),ROW($A$1:INDEX($A:$A,ROW()-1))),0))) 

（非易失性）：

=SUM(INDEX($E:$E,IFERROR(LOOKUP(2,1/($A$1:INDEX($A:$A,ROW()-1)<>""),ROW($A$1:INDEX($A:$A,ROW()-1))),0)+1):INDEX($E:$E,ROW()-1)) 

---

，或者如果你不介意使用一個輔助柱：

在細胞B6：

=IFERROR(LOOKUP(2,1/($A$1:INDEX($A:$A,ROW()-1)<>""),ROW($A$1:INDEX($A:$A,ROW()-1))),0) 

在E6：（揮發性）

=SUM(OFFSET($E6,$B6-ROW()+1,,ROW()-1-$B6)) 

或（非易失性）：

=SUM(INDEX($E:$E,$B6):INDEX($E:$E,ROW()-1)) 

編輯： 想我會一個UDF添加到如果你是在VBA之後計算它。

在希望顯示小計的行中使用函數=AddSubTotal()，或者使用=AddSubTotal("pop",6)來使用「pop」而不是「avg」對F列（第6列）中的所有內容進行求和。

Public Function AddSubTotal(Optional Delim As String = "avg", Optional ColNumber = 5) As Double 

    Dim rCaller As Range 
    Dim rPrevious As Range 
    Dim rSumRange As Range 

    Set rCaller = Application.Caller 

    With rCaller.Parent 
     Set rPrevious = .Range(.Cells(1, 1), .Cells(rCaller.Row - 1, 1)).Find(Delim, , , , , xlPrevious) 
     If Not rPrevious Is Nothing Then 
      Set rSumRange = rPrevious.Offset(1, ColNumber - 1).Resize(rCaller.Row - rPrevious.Row - 1) 
     Else 
      Set rSumRange = .Range(.Cells(1, ColNumber), .Cells(rCaller.Row - 1, ColNumber)) 
     End If 
    End With 

    AddSubTotal = WorksheetFunction.Sum(rSumRange) 

End Function 

Answer 3

變化： 昏暗起點作爲範圍 昏暗endingpoint作爲範圍

到： 昏暗起點作爲變 昏暗endingpoint作爲變

作爲起點和endingpoint在公式中使用的，你不能將它們定義爲Range。

Answer 4

下面的VBA程序認爲

• 你的數據是在列C：é
• 沒有別的相關的（沒有數字），在這個範圍內
• 你的「關鍵詞」，你想展示總和avg
• avg（關鍵詞）是硬編碼在宏

你可以很容易地修改該例程也執行這些值的平均值，並把這些結果，例如，在列d

任何上述的易於修改

---

Option Explicit 
Sub TotalSubRanges() 
    Dim vSrc As Variant, rSrc As Range 
    Dim dAdd As Double 
    Dim I As Long 
    Const sKey As String = "avg" 

Set rSrc = Range(Cells(1, "C"), Cells(Rows.Count, "C").End(xlUp)).Resize(columnsize:=3) 
vSrc = rSrc 

'Do the "work" in a VBA array, as this will 
' execute much faster than working directly 
' on the worksheet 

For I = 1 To UBound(vSrc, 1) 
    If vSrc(I, 1) = sKey Then 
     vSrc(I, 3) = dAdd 
     dAdd = 0 
    Else 
     If IsNumeric(vSrc(I, 3)) Then dAdd = dAdd + vSrc(I, 3) 
    End If 
Next I 

'write the results back to the worksheet 
' and conditionally format the "sum" cells 
With rSrc 
    .EntireColumn.Clear 
    .Value = vSrc 
    .Columns(3).AutoFit 
    .EntireColumn.ColumnWidth = .Columns(3).ColumnWidth 
    .FormatConditions.Delete 
    .FormatConditions.Add _ 
     Type:=xlExpression, _ 
     Formula1:="=" & .Item(1, 1).Address(False, True) & "=""" & sKey & """" 
     With .FormatConditions(1) 
      .Interior.ColorIndex = 6 
     End With 
End With 

End Sub 

---