Question

有人可以帮我解决下面的示例数据。我正在创建一个宏，该宏将显示每个主键的摘要。我尝试使用SumIf，但我的下标超出了范围错误。 Raw Data 原始数据 Primary_Key数量1月价格2月价格 123 2 30 35 123 1 40 45 123 2 45 50 456 5 20 25 456 3 30 35 456 4 25 30 789 2 50 55 789 1 60 65 789 3 65 70

Summary 宏观结果 Primary_Key数量1月价格2月价格 123 5 115 130 456 12 75 90 789 6 175 190

- 修改

感谢您的帮助。我决定使用pivot，然后使用VBA刷新数据源。但是，我收到类型不匹配错误。

Sub CommandButton1_Click()

 Dim Data_sht As Worksheet
 Dim Pivot_sht As Worksheet
 Dim Start As Range
 Dim DataRange As Range
 Dim PivotName As String
 Dim NewRange As String

 Set Data_sht = ThisWorkbook.Worksheets("Raw Data")
 Set Pivot_sht = ThisWorkbook.Worksheets("Summary")

 PivotName = "Summary"

 Set Start = Data_sht.Range("A1")
 Set DataRange = Data_sht.Range(Start, 
 Start.SpecialCells(xlLastCell))

 NewRange = Data_sht.Name & "!" & _
 DataRange.Address(ReferenceStyle:=xlR1C1)

 Pivot_sht.PivotTables(PivotName).ChangePivotCache 
 ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
 SourceData:=DataRange)

 Pivot_sht.PivotTables(PivotName).RefreshTable

 MsgBox PivotName & "'s data source range has been successfully 
 updated!"

End Sub

Answer 1

您可能需要在我的代码中更改引用，但是这个sub应该为您提供帮助。此外，我使用了sumif公式，但如果您的原始数据集变得越来越大，我建议使用集合作为效率度量。

Option Explicit

Sub SumByPK()

Dim dt As Object
Dim lastrow1 As Long
Dim lastrow2 As Long
Dim sh As Worksheet
Dim InputRng As Range
Dim OutRng As Range
Dim rng As Range
Dim qty, JanPrice, FebPrice As Double
Set dt = CreateObject("Scripting.Dictionary")
Set sh = Sheet1 'sheet object, change this if different

lastrow1 = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row 'determines last row, assuming there are no other data in A column but the primary keys.

Set InputRng = sh.Range("A2:A" & lastrow1) 'change the range ref in different
Set OutRng = sh.Range("G2") 'will output unique primary keys onto this range, change this if needed.
For Each rng In InputRng
    If rng.Value <> "" Then
    dt(rng.Value) = ""
    End If
Next rng

OutRng.Range("A1").Resize(dt.Count) = Application.WorksheetFunction.Transpose(dt.Keys)

lastrow2 = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row 'determines last row, assuming there are no other date in G column but the unique primary keys.

For Each rng In sh.Range("G2:G" & lastrow2) 'change the range reference if the OutRng has been changed.
    If rng.Value <> "" Then
        qty = Application.WorksheetFunction.SumIf(sh.Range("A2:A" & lastrow1), rng.Value, sh.Range(Cells(2, 2).Address & ":" & Cells(lastrow1, 2).Address))
        JanPrice = Application.WorksheetFunction.SumIf(sh.Range("A2:A" & lastrow1), rng.Value, sh.Range(Cells(2, 3).Address & ":" & Cells(lastrow1, 3).Address))
        FebPrice = Application.WorksheetFunction.SumIf(sh.Range("A2:A" & lastrow1), rng.Value, sh.Range(Cells(2, 4).Address & ":" & Cells(lastrow1, 4).Address))
        rng.Offset(0, 1).Value = qty
        rng.Offset(0, 2).Value = JanPrice
        rng.Offset(0, 3).Value = FebPrice
    End If
Next rng

End Sub�
�

SumIf使用Excel VBA

1 个答案: