VBA:仅用于背景填充单元格的输入SUM公式

时间:2017-09-07 18:31:10

标签: excel vba excel-vba

我是VBA的新手,我正在尝试编写一段代码,将总和公式插入到蓝色单元格中,然后总结到下一个蓝色单元格(参见附件)。我需要这样做的原因是因为这将是一个模板,用于将文本文件插入此电子表格的用户,所以我希望它格式化单元格并添加公式,这样如果他们决定添加一个新行,它将自动重新计算总数。任何帮助将不胜感激!!!如果您需要更多细节,请告诉我们!

F1

1 个答案:

答案 0 :(得分:1)

不确定您的其他数据如何通过屏幕截图,但这样的事情应该有效。我试图尽可能彻底地评论,以帮助解释它是如何完成的,这样你就可以更多地了解VBA的工作原理。

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

我建议您查看帮助中心(https://stackoverflow.com/help)并阅读其中的一些主题,因为在不显示您尝试过的内容的情况下发布此类问题通常会很快关闭。