Sub SumBetweenBlues()
'declare your variables
Dim ws As Worksheet
Dim x As Long, y As Long, endRow As Long, startSum As Long, endSum As Long, xBlue as Long
Dim colL As String
'set the worksheet to work with (this can be changed if necessary)
Set ws = ActiveWorkbook.ActiveSheet
'set the color of blue to check for
xBlue = RGB(201, 234, 236)
'column where the sums will be put (C)
Const sumCol As Integer = 3
'first row
Const startRow As Integer = 2
'turns the column number into a letter for the formula
colL = colLetter(sumCol)
'determines the last used row and goes a bit past it since blues may/may not be blank themselves
endRow = ws.Cells(ws.Rows.Count, sumCol).End(xlUp).Row + 50
'loop through all the cells in the sum column
For x = startRow To endRow
'checks if the cell is blue
If ws.Cells(x, sumCol).Interior.Color = xBlue Then
'set the start of the sum range to the cell after the blue cell
startSum = x + 1
'find the end of the sum range
For y = startSum + 1 To endRow
'checks if the cell is also blue
If ws.Cells(y, sumCol).Interior.Color = xBlue Then
'sets the end of the sum range to the cell before the blue cell
endSum = y - 1
Exit For
End If
Next y
'so long as an endsum area was found, set the formula in the blue cell
If endSum <> 0 Then
ws.Cells(x, sumCol).Formula = "=SUM(" & colL & startSum & ":" & colL & endSum & ")"
End If
'skip all the non-blue cells inbetween
x = y - 1
'reset the start/end of the sum area
startSum = 0
endSum = 0
End If
Next x
End Sub
'---------------------------------------------------------------------------
Function colLetter(intCol As Integer) As String
'this function turns column numbers into letters
Dim vArr: vArr = Split(Cells(1, intCol).Address(True, False), "$"): colLetter = vArr(0)
End Function
1 回答
不确定您的其他数据如何通过屏幕截图，但这样的事情应该有效 . 我试图尽可能彻底地评论，以帮助解释它是如何完成的，这样你就可以更多地了解VBA的工作原理 .
我建议查看帮助中心（https://stackoverflow.com/help）并阅读其中的一些主题，因为发布这样的问题而不显示您尝试过的内容通常会很快关闭 .