Excel VBA – 使用macros汇总数据

我想知道如果有人愿意给我一个新手VBA的帮助。 在表一中，我有这样的数据格式：

表1

我想要做的是使用VBA吐出下面的图dynamic填充该区域取决于它find多less：

表2

这是我的第一个VBA，所以我徘徊了一下。 这是我如何解决这个问题的想法：

我的想法是向下滚动Sheet1 col A中的数据中的string，并确定它是否是我们以前见过的date：

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

问题

1. 这个stream程图是否采取了正确的方法？

2. 如果是这样的话，我该如何实现这种“这是否独一无二，如果是这样做，如果不这样做”那种设置。

我真的很感谢一些帮助实现这个代码的开始，所以我有一些东西要build立。

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

Answer 1

对于不同的方法，请参阅下面：

工作表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 

Answer 2

首先，我同意其他人的看法，您应该使用Pivot Table的内置function来寻找解决scheme。

既然你提到它不符合你的期望，我把一些代码按照你的要求汇总起来。 让我知道它是否有诀窍，如果您需要任何额外的帮助调整您的需求，或者如果您有任何其他一般问题。

 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