使用Excel VBA汇总数据

Question

我是VBA的初学者。在第一张表格中，我的数据格式如下：

第1页

我想要做的是使用VBA吐出以下图表，该图表根据发现的数量动态填充区域：

第2页

这是我的第一个VBA，所以我有点挣扎。这是我如何解决这个问题的想法：

我的想法是向下滚动我在sheet1 col A中的数据中的字符串，并确定它是否是我们之前看到过的日期：

Public Sub Test()

ActiveSheet.Range("Sheet1!A1:A5000").AdvancedFilter Action:=xlFilterCopy, CopyToRange.Range("Sheet2!A1"), Unique:=True

End Sub

问题

1. 此流程图采用了正确的方法吗？

2. 如果是这样，我该如何实现这种＆＃34;这是否是唯一的，如果这样做，如果不这样做＆＃34;一种设置。

如何启动此代码以便我可以构建一些内容？

这是我到目前为止所做的： https://gist.githubusercontent.com/employ/af67485b8acddce419a2/raw/6dda3bb1841517731867baec56a0bf2ecf7733a7/gistfile1.txt

Answer 1

首先，我同意其他人的观点，即您应该使用Pivot Table的内置功能寻找解决方案。

由于您已经提到它不符合您的期望，我将一些代码汇总在一起，以便按照您的要求汇总数据。如果你需要任何额外的帮助来根据你的需要调整它，或者你有任何其他一般性问题，请告诉我。

Sub SummarizeInNewSheet()
    Dim wsOrigin As Worksheet
    Dim wsDest As Worksheet
    Dim rngOrigin As Range
    Dim oDict As Object
    Dim cel As Range
    Dim rngLocations As Range
    Dim nLastRow As Long
    Dim nLastCol As Long
    Dim rngInterior As Range
    Dim rngAllDates As Range
    Dim rngAllLocations As Range
    Dim rngAllSales As Range

    Application.ScreenUpdating = False

    Set wsOrigin = Worksheets("Sheet1")
    Set wsDest = Worksheets("Sheet2")
    Set rngOrigin = wsOrigin.Range("A1").CurrentRegion

    Intersect(rngOrigin, wsOrigin.Columns(1)).Copy wsDest.Range("A1")
    wsDest.Range(wsDest.Range("A1"), wsDest.Range("A1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlYes

    Set oDict = CreateObject("Scripting.Dictionary")
    Set rngLocations = wsDest.Range("B1")
    For Each cel In Intersect(rngOrigin, wsOrigin.Columns(3))
        If cel.Row = 1 Then
        Else
            If oDict.exists(cel.Value) Then
                'Do nothing for now
            Else
                oDict.Add cel.Value, 0
                rngLocations.Value = cel.Value
                Set rngLocations = rngLocations.Offset(, 1)
            End If
        End If
    Next cel

    nLastRow = wsDest.Cells(Rows.Count, 1).End(xlUp).Row
    nLastCol = wsDest.Cells(1, Columns.Count).End(xlToLeft).Column
    Set rngInterior = wsDest.Range(wsDest.Range("B2"), wsDest.Cells(nLastRow, nLastCol))

    Set rngAllDates = wsOrigin.Range(wsOrigin.Range("A2"), wsOrigin.Range("A2").End(xlDown))
    Set rngAllSales = wsOrigin.Range(wsOrigin.Range("B2"), wsOrigin.Range("B2").End(xlDown))
    Set rngAllLocations = wsOrigin.Range(wsOrigin.Range("C2"), wsOrigin.Range("C2").End(xlDown))

    For Each cel In rngInterior
        cel.Value = Application.WorksheetFunction.SumIfs(rngAllSales, rngAllDates, wsDest.Cells(cel.Row, 1), rngAllLocations, wsDest.Cells(1, cel.Column))
    Next cel

    Application.ScreenUpdating = True
End Sub

Answer 2

有关不同的方法，请参阅以下内容：

第1页布局（来源）：

表2布局（目标）：

Sub SalesRegion()
Dim ws1, ws2 As Worksheet
Dim wb As Workbook
Dim ws1LastRow, ws2LastRow, salesVal  As Long
Dim destFind, dateFind As Range
Dim destStr As String
Dim dateStr As Date
Dim targetCol, targetRow As Long


Set wb = ActiveWorkbook '<- Your workbook
Set ws1 = wb.Sheets("Sheet1")  '<- Your source worksheet
Set ws2 = wb.Sheets("Sheet2") '<- Your destination worksheet

ws1LastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To ws1LastRow
destStr = ws1.Range("C" & i).Value
dateStr = ws1.Range("A" & i).Value
salesVal = ws1.Range("B" & i).Value

With ws2.Rows("1:1") '<- row on destination sheet which contains countries
    Set destFind = .Find(What:=destStr, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
            If Not destFind Is Nothing Then
                targetCol = destFind.Column
                With ws2.Columns("A:A") '<- Column on destination sheet which contains months
                'You may need to adjust date format below depending on your regional settings
                Set dateFind = .Find(What:=Format(ws1.Range("A" & i).Value, "MMM-yy"), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
                        If Not dateFind Is Nothing Then
                            targetRow = dateFind.Row
                            ws2.Cells(targetRow, targetCol).Value = ws2.Cells(targetRow, targetCol).Value + salesVal
                        Else
                            ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = dateStr
                            targetRow = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
                            ws2.Cells(targetRow, targetCol).Value = salesVal

                        End If
                End With
            Else

            ws2.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Value = destStr
            targetCol = ws2.Cells(1, Columns.Count).End(xlToLeft).Column

            With ws2.Columns("A:A") '<- Column on destination sheet which contains months
                'You may need to adjust date format below depending on your regional settings
            Set dateFind = .Find(What:=Format(ws1.Range("A" & i).Value, "MMM-yy"), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
                    If Not dateFind Is Nothing Then
                        targetRow = dateFind.Row
                        ws2.Cells(targetRow, targetCol).Value = ws2.Cells(targetRow, targetCol).Value + salesVal

                        Else
                            ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = dateStr
                            targetRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
                            ws2.Cells(targetRow, targetCol).Value = salesVal

                    End If
            End With
            End If
End With
Next
End Sub