如何通过代码实现将表中相对应匹配的数据求和

错觉错觉7

这是一张销售的数据表，做的时候遇到了瓶颈，我想实现的功能就是如何把表格上述单元格内年份后对应的数字（如DR2019.41、2019.42、2019.43对应的是10月）填入下方我列出来的区间中求和。有没有大佬能帮萌新解决这个问题，感觉如果不用代码好像实现不了匹配数字区间。而且如果我下次遇到新的销售数据表若是从2020.1-2020.4（第一周到第四周）那么我就可以将新数据继续填入下方单元格中。
若是有大佬能帮我解决这个问题我真的很感激！！！谢谢！！！

answer6141

结果不太对，看着你这些英文头疼，应该是数组除了问题，已经很接近正确答案了
提供个思路给你，能力有限，做了快2个小时了，明天再改睡觉了，等待大神出现，看有没有简单的方法

answer6141

先传上去明天要去公司

answer6141

1. Sub test()
   
2. Dim i, j, k, l, xrow, ycol As Long
   
3. Dim m1, m2, m3, m4, m5, m6, m7, m8, m9, m10, m11, m12 As Single
   
4. Dim arr, brr
   
5. Dim d As Object
   
6. With Sheets(1)
   
7.     xrow = .Cells(1, 2).End(xlDown).Row
   
8.     ycol = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column
   
9.     arr = .Range(.Cells(1, 1), .Cells(xrow, ycol))
   
10.     ReDim brr(UBound(arr, 1) - 1, 15)
    
11.     For i = 2 To UBound(arr, 1)
    
12.         brr(i - 2, 0) = arr(i, 2)
    
13.         brr(i - 2, 14) = arr(i, 5)
    
14.         For j = 1 To UBound(arr, 2)
    
15.             If (j + 9) <= UBound(arr, 2) Then
    
16.                 k = Split(arr(1, j + 9), ".")(1) * 1
    
17.                 If k >= 1 And k <= 4 Then
    
18.                     m1 = arr(i, j + 9) + m1
    
19.                     brr(i - 2, 1) = m1
    
20.                 ElseIf k >= 5 And k <= 8 Then
    
21.                     m2 = arr(i, j + 9) + m2
    
22.                     brr(i - 2, 2) = m2
    
23.                 ElseIf k >= 9 And k <= 13 Then
    
24.                     m3 = arr(i, j + 9) + m3
    
25.                     brr(i - 2, 3) = m3
    
26.                 ElseIf k >= 14 And k <= 17 Then
    
27.                     m4 = arr(i, j + 9) + m4
    
28.                     brr(i - 2, 4) = m4
    
29.                 ElseIf k >= 18 And k <= 22 Then
    
30.                     m5 = arr(i, j + 9) + m5
    
31.                     brr(i - 2, 5) = m5
    
32.                 ElseIf k >= 23 And k <= 26 Then
    
33.                     m6 = arr(i, j + 9) + m6
    
34.                     brr(i - 2, 6) = m6
    
35.                 ElseIf k >= 27 And k <= 30 Then
    
36.                     m7 = arr(i, j + 9) + m7
    
37.                     brr(i - 2, 7) = m7
    
38.                 ElseIf k >= 31 And k <= 35 Then
    
39.                     m8 = arr(i, j + 9) + m8
    
40.                     brr(i - 2, 8) = m8
    
41.                 ElseIf k >= 36 And k <= 39 Then
    
42.                     m8 = arr(i, j + 9) + m8
    
43.                     brr(i - 2, 9) = m8
    
44.                 ElseIf k >= 40 And k <= 43 Then
    
45.                     m9 = arr(i, j + 9) + m9
    
46.                     brr(i - 2, 10) = m9
    
47.                 ElseIf k >= 44 And k <= 48 Then
    
48.                     m11 = arr(i, j + 9) + m11
    
49.                     brr(i - 2, 11) = m11
    
50.                 ElseIf k >= 49 And k <= 52 Then
    
51.                     m12 = arr(i, j + 9) + m12
    
52.                     brr(i - 2, 12) = m12
    
53.                 End If
    
54.             End If
    
55.         Next
    
56.     Next
    
57.     Debug.Print brr(0, 0)
    
58.     .Range("a18").Resize(UBound(brr, 1) + 1, UBound(brr, 2) + 1) = brr
    
59. End With
    
60. End Sub
    

复制代码

又审核？

answer6141

answer6141 发表于 2020-1-30 10:20
又审核？

这个应该对了，昨天有点懵，数组下标搞错了

excel海

应该满足需求,数据表别搞这么乱好处理得多

1. Option Explicit
   
2. Sub Msm()
   
3.     Dim arr, i, n, brr, j, ss, s, k, l, h, d
   
4.     Dim dic
   
5.     Set dic = CreateObject("scripting.dictionary")
   
6.     arr = Sheet1.Range("a1:ao9")
   
7.     For i = 1 To UBound(arr)
   
8.         dic(arr(i, 2)) = i
   
9.     Next
   
10.     brr = Sheet1.Range("a17:m25")
    
11.     For i = 1 To UBound(brr)
    
12.         If dic.exists(brr(i, 1)) Then
    
13.             For j = 2 To UBound(brr, 2)
    
14.                 h = 0
    
15.                 ss = Split(brr(1, j), "月")
    
16.                 s = Split(ss(1), "-")
    
17. '                For k = s(0) To s(UBound(s))
    
18.                     For n = 1 To UBound(arr, 2)
    
19.                         If arr(1, n) Like "DR*2019*" Then
    
20.                             d = Split(arr(1, n), ".")(1)
    
21.                             If Val(d) >= Val(s(0)) And Val(d) <= Val(s(UBound(s))) Then
    
22.                                  h = h + arr(i, n)
    
23.                             End If
    
24.                         End If
    
25.                     Next
    
26. '                Next
    
27.                 brr(i, j) = h
    
28.             Next
    
29.         End If
    
30.     Next
    
31.     Sheet1.Range("a17:m25") = brr
    
32. End Sub
    

复制代码

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, n, t
  arr = Range("j1:ao" & [j1].End(xlDown).Row)
  ReDim brr(1 To UBound(arr, 1) - 1, 1 To 12)
  For j = 1 To UBound(arr, 2)
    t = Split(arr(1, j), ".")
    n = Month(DateAdd("ww", t(1), Right(t(0), 4) & "-1-1"))
    For i = 2 To UBound(arr, 1)
      brr(i - 1, n) = brr(i - 1, n) + arr(i, j)
    Next
  Next
  [b18].Resize(UBound(brr, 1), 12) = brr
End Sub

错觉错觉7

answer6141 发表于 2020-1-30 00:42
结果不太对，看着你这些英文头疼，应该是数组除了问题，已经很接近正确答案了
提供个思路 ...

谢谢大佬！！可能是我描述的问题 B2列是各种不同的商品名 然后只需要把每一行他们的和算出来就行 不需要向下累加 这个能麻烦你帮我实现嘛~

错觉错觉7

answer6141 发表于 2020-1-30 00:42
结果不太对，看着你这些英文头疼，应该是数组除了问题，已经很接近正确答案了
提供个思路 ...

谢谢大佬哈！ 但是可能是我的描述问题 表格中B2列是商品名 求和只需要把他们分别的和算出来就行了 我看你好像是理解成向下累加的 是我描述不清的原因 这个功能可以麻烦实现嘛~

错觉错觉7

一把小刀闯天下 发表于 2020-1-30 12:12
Option Explicit

Sub test()

大佬你好 这个算法我验证了下数据好像只有部分和是对的 还可以改进改进吗