使用 Excel VBA 汇总数据
Summarize data using Excel VBA
我是 VBA 的初学者。在 sheet 上,我的数据格式如下:
SHEET 1
我想要做的是使用 VBA 吐出以下图表,该图表根据找到的数量动态填充区域:
SHEET 2
这是我的第一个 VBA 所以我有点挣扎。这是我对如何解决这个问题的想法:
我的想法是在 sheet1 列 A 中向下滚动我的数据中的字符串,并确定它是否是我们之前看到的日期:
Public Sub Test()
ActiveSheet.Range("Sheet1!A1:A5000").AdvancedFilter Action:=xlFilterCopy, CopyToRange.Range("Sheet2!A1"), Unique:=True
End Sub
问题
这个流程图是否采用了正确的方法?
如果是这样,我该如何实现这种 "Is this unique, if so do this, if not do this" 设置。
我怎样才能开始这段代码,这样我就有东西可以构建了?
首先,我同意其他人的意见,您应该使用 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
不同的方法请看下面:
Sheet 1 布局(来源):
Sheet 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
我是 VBA 的初学者。在 sheet 上,我的数据格式如下:
SHEET 1
我想要做的是使用 VBA 吐出以下图表,该图表根据找到的数量动态填充区域:
SHEET 2
这是我的第一个 VBA 所以我有点挣扎。这是我对如何解决这个问题的想法:
我的想法是在 sheet1 列 A 中向下滚动我的数据中的字符串,并确定它是否是我们之前看到的日期:
Public Sub Test()
ActiveSheet.Range("Sheet1!A1:A5000").AdvancedFilter Action:=xlFilterCopy, CopyToRange.Range("Sheet2!A1"), Unique:=True
End Sub
问题
这个流程图是否采用了正确的方法?
如果是这样,我该如何实现这种 "Is this unique, if so do this, if not do this" 设置。
我怎样才能开始这段代码,这样我就有东西可以构建了?
首先,我同意其他人的意见,您应该使用 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
不同的方法请看下面:
Sheet 1 布局(来源):
Sheet 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