按区域对字段名称汇总--类似隔列求和

jjmysjg

FR列向右的列，是按第一行的时间段对相应的第2行标题进行累加(借方合计、贷方合计)。
本汇总数是公式计算的。
由于公式不能连续右拉，希望VBA解决--区域按标题名称(借方合计、贷方合计)汇总。如能绿色按键更好。
数据行数不定。
谢谢各位！

shiruiqiang

说实话，看见你这张表，我建议把做表的人换一个吧。
自己搞自己脑子。
函数都用不了表，只能手工做的，只能是废表。

limonet

shiruiqiang 发表于 2025-3-25 21:44
说实话，看见你这张表，我建议把做表的人换一个吧。
自己搞自己脑子。
函数都用不了表，只能手工做的，只 ...

假如是1楼做的呢？

shiruiqiang

目前就vba能偷偷懒。
先把要求求和的日期split
循环第一行的列，判断是否在期内
是的话分别“借”=“借”+arr(1，y),“贷”=“贷”+arr(1，y+1)
197列

shiruiqiang

limonet 发表于 2025-3-25 21:46
假如是1楼做的呢？

报表让1楼手工做算了

好做一点，第一行插入了列号

lcluck2002

jjmysjg

shiruiqiang 发表于 2025-3-25 22:12
报表让1楼手工做算了

好做一点，第一行插入了列号

实现了，但结果不对--原因是后来发现DT、DU列是多余的列。

shiruiqiang

jjmysjg 发表于 2025-3-26 07:29
实现了，但结果不对--原因是后来发现DT、DU列是多余的列。

所以说你这样设计表格有问题
很多统计必须手工去做

翁知江安

Sub test()
Dim i, j, s, t, jhejijine, dhejijine
Dim ar As Variant
Dim mj As String
Dim startyear, endyear As Integer
s = Val(InputBox("请输入起始年份（格式：yyyy):   "))
t = Val(InputBox("请输入终了年份（格式：yyyy):   "))
If s > t Then
MsgBox "您输入的起止年份有误，请重新输入"
s = Val(InputBox("请输入起始年份（格式：yyyy):   "))
t = Val(InputBox("请输入终了年份（格式：yyyy):   "))
End If
mj = s & "." & "07" & "-" & t & "." & "06"
ar = Sheet1.UsedRange
For j = 174 To UBound(ar, 2) - 3 Step 4
If mj = ar(1, j) Then
  For i = 3 To UBound(ar)
   If Len(ar(i, 2)) = 3 Then
      If ar(2, j) = "借方合计" Then
      jhejijine = jhejijine + ar(i, j)
      End If
      If ar(2, j + 1) = "贷方合计" Then
      dhejijine = dhejijine + ar(i, j + 1)
      End If
    End If
Next
    Else
     startyear = Val(Mid(ar(1, j), 1, 4))
     endyear = Val(Mid(ar(1, j), 9, 4))
     If startyear >= s And endyear <= t Then
    For i = 3 To UBound(ar)
     If Len(ar(i, 2)) = 3 Then
        If ar(2, j) = "借方合计" Then
        jhejijine = jhejijine + ar(i, j)
        End If
        If ar(2, j + 1) = "贷方合计" Then
        dhejijine = dhejijine + ar(i, j + 1)
        End If
     End If
    Next
   End If
  End If
Next
MsgBox mj & "借方金额合计为" & jhejijine & "元"
MsgBox mj & "贷方金额合计为" & dhejijine & "元"
End Sub

翁知江安

将起止年份改成了动态输入，方便使用。供参考，欢迎批评指正。