根据Excel中的列值聚合数据

时间:2012-09-17 15:16:00

标签: excel vba excel-vba report

我正在完全编辑这个问题,因为现在所需的结果有所改变。此外,我同意,这个问题没有适当地提出给你们。

我有一个电子表格,即Main Spreadsheet,其中包含列出的活动/行。我想通知受让人他们将要开展的活动以及日期。 我能写一封发送宏的电子邮件,但问题是要到达那个阶段! 我们如何排序,然后确保收件人只有一个人是受让人,并且他的名字不在“TO”字段中不止一次。 (应用for循环会产生痛苦!)

主电子表格:

Date    Assignee    Activity
08/01   Player X    Activity 1
08/01   Player Y    Activity 1
08/02   Player X    Activity 2
08/02   Player Y    Activity 2
08/02   Player Z    Activity 1

要计算的报告:

Assignee    Activity List
Player X    Activity 1
Player X    Activity 2

1 个答案:

答案 0 :(得分:0)

您可以使用For循环并将活动(和/或任何其他相关信息)分配给特定于人的数组。然后使用该数组填充电子邮件。

这不是很优雅,但它会运行您提供的示例数据。您可以使用数组数据(并遍历项目)或使用逗号分隔的字符串为播放器填充电子邮件。

Public Sub ReportToPeople()
    Dim i As Integer, j As Integer
    Dim arrPlayerX()
    Dim arrPlayerY()
    Dim arrPlayerZ()
    Dim strPlayerX As String
    Dim strPlayerY As String
    Dim strPlayerZ As String

    ReDim arrPlayerX(1 To 1)
    ReDim arrPlayerY(1 To 1)
    ReDim arrPlayerZ(1 To 1)

    ' No clue how large your dataset is...
    For i = 2 To 100
        If Cells(i, 1).Value = vbNullString Then Exit For
        Select Case Cells(i, 2).Value
            Case "Player X"
                Call fArrIncrementAndAdd(arrPlayerX, Cells(i, 3).Value, strPlayerX)
            Case "Player Y"
                Call fArrIncrementAndAdd(arrPlayerY, Cells(i, 3).Value, strPlayerY)
            Case "Player Z"
                Call fArrIncrementAndAdd(arrPlayerZ, Cells(i, 3).Value, strPlayerZ)
        End Select
    Next i
    Call MsgBox(strPlayerX) 'or use Debug.Print strPlayerX
End Sub


Public Function fArrIncrementAndAdd(ByRef arrTheArray, ByVal strValueToAdd, ByRef strWholeString)
    Dim c As Integer

    c = UBound(arrTheArray)
    If arrTheArray(c) <> vbNullString Then ReDim Preserve arrTheArray(1 To (c + 1))
    arrTheArray(c) = strValueToAdd
    strWholeString = strWholeString & "," & strValueToAdd
    If UBound(arrTheArray) = 1 Then strWholeString = Replace(strWholeString, ",", "") ' removes leading comma on first item

End Function