每个数组值运行6个月的总和

时间:2019-03-29 16:21:44

标签: arrays excel vba

我正在尝试为每个徽章编号计算6个月的“总积分”。该总和仅适用于点大于0的字段。

我一直在尝试使用数组和For语句来执行此操作,但是我什么也没得到。

Sub TestArray()
'
'
'
' Test Array Macro

    Dim Badges() As Long
    Dim Badge As Variant
    Dim i As Long
    Dim x As Double
    Dim Worksheet1 As Worksheet
    Dim AbsCode As Long
    Dim sht As Worksheet
    Dim LastRow As Long

Set sht = ActiveSheet

'Using Find Function
  LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row


    Set Worksheet1 = ActiveWorkbook.Worksheets("Attendance Data") ' Change name of sheet if necessary
    BadgeNo = 1
    AbsCode = 3
    Hours = 5
    Points = 9
    Rules = 10
    test = 15

    ReDim Badges(2 To LastRow, 1 To 1)

    For Each Badge In Badges        
        For i = 2 To LastRow
            If Worksheet1.Cells(i, Points).Value > 0 Then
                Worksheet1.Cells(i, test).Value = Application.WorksheetFunction.Sum(Worksheet1.Cells(i, Points).Value)
            Else: Worksheet1.Cells(i, test).Value = 0
            End If
            Next i
    Next Name



End Sub

我正在寻找的答案在下面的“ 6个月积分”列中。

Badge No.   Incident Date   Points  6 Month Points
30004832    1/13/2018       0.5           0.5
30004832    1/27/2018       0.0           0
30004832    4/5/2018        1.0           1.5
30004832    7/19/2018       0.0           0
30004832    7/22/2018       0.5           1.5
30004832    9/22/2018       1.0           2.5
30005505    8/4/2018        0.5           0.5
30005505    12/6/2018       0.5           1
30005914    12/20/2018      0.0           0
30004641    1/18/2018       0.5           0.5
30004641    2/2/2018        0.5           1
30004641    7/17/2018       0.0           0
30004641    10/16/2018      0.0           0
30000503    4/12/2012       0.0           0
30000503    5/3/2012        0.0           0
30000503    6/14/2012       0.0           0

0 个答案:

没有答案