Question

我有2列，在B列中，中间有一个空白列表，空白之前的文本数可以变化。我需要在其旁边的列的第一行文本中插入范围的总和。我的两次vba尝试都成功了，但后来又开始了。
选项1：Works会在文本上方插入“ sum =“范围。
选项2：这会插入正确的位置，但只会插入“ FALSE”。

Example:
Column B:     ColumnC:
Header1       =SUM(B1:B4) eg. the sum of the range before first blank.
Sub1
Sub2
Sub3
"blank"
Header2       =SUM(B6:B8) eg. the sum of the range before first blank.
Sub1
Sub2
"blank"

Sub KSV_Option_1()
        Dim KSV_SrchRng As Range, cel As Range, KSV_Contain As String
        Set KSV_SrchRng = Range("B1:B99")
        For Each cel In KSV_SrchRng
            If InStr(cel.Value, "Forsikringspræmie") > 0 Then
                KSV_Contain = cel.Value
            ElseIf cel.Value <> "" Then
                    Dim xRg As Range
                    Dim i, j, StartRow, StartCol As Integer
                    Set xRg = Range("B1:B99")
                    StartRow = xRg.Row
                    StartCol = xRg.Column
                    For i = StartCol To xRg.Columns.Count + StartCol - 1
                        For j = xRg.Row To xRg.Rows.Count + StartRow - 1
                            If Cells(j, i) = "" Then
                                 Cells(j, i).Formula = "=SUM(" & Cells(StartRow, i).Address & ":" & Cells(j - 1, i).Address & ")"
                                StartRow = j + 1
                            End If
                        Next
                        StartRow = xRg.Row
                    Next
                End If
        Next cel
End Sub


Sub KSV_Option_2()
        Dim KSV_SrchRng As Range, cel As Range, KSV_Contain As String
        Set KSV_SrchRng = Range("B1:B99")
        For Each cel In KSV_SrchRng
            If InStr(cel.Value, "Forsikringspræmie") > 0 Then
                KSV_Contain = cel.Value
            ElseIf cel.Value <> "" Then
                    Dim xRg As Range
                    Dim i, j, StartRow, StartCol As Integer
                    Set xRg = Range("B1:B99")
                    StartRow = xRg.Row
                    StartCol = xRg.Column
                    For i = StartCol To xRg.Columns.Count + StartCol - 1
                        For j = xRg.Row To xRg.Rows.Count + StartRow - 1
                            If Cells(j, i) = "" Then
                                 cel.Offset(0, 1).Value = Cells(j, i).Formula = "=SUM(" & Cells(StartRow, i).Address & ":" & Cells(j - 1, i).Address & ")"
                                StartRow = j + 1
                            End If
                        Next
                        StartRow = xRg.Row
                    Next
                End If
        Next cel
End Sub

Answer 1

我认为您正在尝试将“ Col B”中用空格分隔的多个范围内的值求和。如果我是正确的话，这是一个简单的代码，它将对“ Col B”中多个范围内的值进行求和，这些值之间用空白单元格分隔。 Sum公式将插入到每个sumRng中第一个单元格右侧的“ Col C”中。根据需要更改工作表名称。

For Each sumRng In Sheets("Sheet1").Columns("B").SpecialCells(xlConstants, xlNumbers).Areas
    sumA = sumRng.Address(False, False)
    sumRng.Offset(, 1).Resize(1, 1).Formula = "=SUM(" & sumA & ")"
Next sumRng

如果您只是想计算范围内的单元格数量，则可以使用此简单代码。如果要对带有数字的单元格进行计数，请使用xlNumbers，如果要对带有文本的单元格进行计数，请使用xlConstants。

For Each cntRng In Sheets("Sheet1").Columns("B").SpecialCells(xlConstants, xlNumbers).Areas
    cntA = cntRng.Address(False, False)
    cntRng.Offset(, 1).Resize(1, 1) = cntRng.Count
Next cntRng

总和直到空白

1 个答案: