向下求和或利用VBA计算

seao · 发表于 2019-6-12 10:50

因行次较多未级行次不一致求公式或VBA 列示。谢谢大神，在线求助。

seao · 发表于 2019-6-12 10:51

帮忙支持一下

seao · 发表于 2019-6-12 11:22

么人理啊帮个忙吧

大灰狼1976 · 发表于 2019-6-12 11:55

如下：

Sub test()
Dim i&, r&, n#
For i = 3 To [e65536].End(3).Row
If Cells(i, 6) = "" Then
If i > 3 Then
Cells(r, 6) = n
n = 0
End If
r = i
Else
n = n + Cells(i, 6)
End If
Next i
Cells(r, 6) = n
End Sub

复制代码

ccwan · 发表于 2019-6-12 11:57

Sub cc()
Dim arr, i%, j%, num&
arr = [e2].CurrentRegion
For i = 2 To UBound(arr)
If arr(i, 2) = "" Then
j = i
Do
num = num + arr(i + 1, 2)
i = i + 1
If i = UBound(arr) Then Exit Do
Loop Until arr(i, 1) = "二级"
i = i - 1
arr(j, 2) = num: num = 0
End If
Next
[e2].Resize(UBound(arr), 2) = arr
End Sub

复制代码

seao · 发表于 2019-6-12 12:51

大灰狼1976 发表于 2019-6-12 11:55
如下：

谢谢帮忙我测试一下

seao · 发表于 2019-6-12 12:52

ccwan 发表于 2019-6-12 11:57

谢谢帮忙我测试一下

lsdongjh · 发表于 2019-6-12 13:10

Sub Test()
Dim lngEndRow As Long, lngRow As Long
Dim rg As Range, lngOffSet As Long
lngEndRow = Sheet1.Range("E" & Rows.Count).End(xlUp).Row
For lngRow = lngEndRow To 3 Step -1
Set rg = Sheet1.Range("E" & lngRow)
If rg.Value = "二级" Then
rg.Offset(0, 1).Value = Application.WorksheetFunction.Sum(rg.Offset(1, 1).Resize(lngOffSet, 1))
lngOffSet = 0
Else
lngOffSet = lngOffSet + 1
End If
Next
End Sub

复制代码

vic9 · 发表于 2019-6-12 14:31

Sub fg()

Dim arr, i, sm, brr(1 To 29, 1 To 1)
arr = Range("e3:f31")
For i = UBound(arr) To 1 Step -1
      If arr(i, 1) <> "二级" Then
         sm = sm + arr(i, 2)
      Else
         brr(i, 1) = sm
         sm = 0
      End If
Next
[f3].Resize(UBound(brr)) = brr
End Sub

seao · 发表于 2019-6-12 14:59

vic9 发表于 2019-6-12 14:31
Sub fg()

Dim arr, i, sm, brr(1 To 29, 1 To 1)

谢谢大神啊向你学习

		自动登录	找回密码
密码			免费注册

[求助] 向下求和或利用VBA计算

最新热点 /1