SUMIF作为Excel中的macros(VBA)

所以这是我正在合作的概念。

我有Sheet1上有许多键和值:

在这里输入图像说明

然后在sheet2上,我一直使用SUMIF函数来计算sheet1中的总值:

在这里输入图像说明

这只是一个例子,实际的数据集要大得多。 我需要devise一个macros将自动生成并将SUMIF公式插入到sheet2中正确的单元格中。 任何人都可以想办法做到这一点?

即使不知道任何其他要求或您正在做什么,或者有多less列或关键字或其他什么,您可以:

  1. logging一个macros,
  2. 分配给一个button,
  3. 编写一行代码,以便用户单击button时,它将在所选列上(或select列的第一个单元格时)运行macros。

如果有100列以上是很乏味,你会想要一个macros来循环这一切,但我不知道你有什么需要。

这是一个解决scheme。

With [sheet1!a1:index(sheet1!a:a,count(sheet1!a:a))] [b1:index(sheet2!b:b,count(sheet2!a:a))].Offset(1).Formula = _ "=sumif(sheet1!" & .Offset(1).Address & ",a2,sheet1!" & .Offset(1, 1).Address & ")" End With 

这假设sheet2上的列A已经就位。 同样,它假设sheet2上的列B的标题已经就位,并且列B的其余部分是空白的并且将被上面的代码填充。

它也采用数字键。

如果任何假设是错误的,这个解决scheme可以很容易地调整。 请让我知道

我会从表单中读取数据,然后构build第二张表格。 您将需要添加adodblogging集的引用。 在VBA IDE的工具下拉菜单中select参考。 select“Microsoft ActiveX数据对象2.8库”。

 Private Sub CommandButton10_Click() Dim rs As New ADODB.Recordset Dim ws As Excel.Worksheet Dim lRow As Long Dim lLastRowSheet1 As Long Set ws = ActiveWorkbook.Sheets("Sheet1") 'Add fields to your recordset for storing data. With rs .Fields.Append "Row", adInteger .Fields.Append "Key", adInteger .Fields.Append "Val", adInteger .Open End With lLastRowSheet1 = ws.UsedRange.Rows.count lRow = 1 'Loop through and record what is in the columns Do While lRow <= ws.UsedRange.Rows.count rs.AddNew rs.Fields("Row").Value = lRow rs.Fields("Key").Value = ws.Range("A" & lRow).Value rs.Fields("Val").Value = ws.Range("B" & lRow).Value rs.Update lRow = lRow + 1 ws.Range("A" & lRow).Activate Loop If rs.EOF = False Then rs.MoveFirst End If 'Switch to the second worksheet Set ws = Nothing Set ws = ActiveWorkbook.Sheets("Sheet2") 'Now go through the data from sheet one and build the list of keys Dim iLastKey As Integer lRow = 1 Do While rs.EOF = False 'For each unique key add a row to the second sheet. If rs.Fields("Key").Value <> iLastKey Then ws.Range("A" & lRow).Value = rs.Fields("Key").Value ws.Range("B" & lRow).Formula = "=sumif(sheet1!$A$2:$A$" & lLastRowSheet1 & ",A" & lRow & ",Sheet1!$B$2:$B$" & lLastRowSheet1 & ")" lRow = lRow + 1 End If iLastKey = rs.Fields("Key").Value rs.MoveNext Loop End Sub 

这是我最终使用的:

 Sub GetKeyVals() ' GetKeyVals Macro ' Get the key values based on the Unique customer codes ' Define sheet Dim Extract As Worksheet Set Extract = ActiveSheet 'Define lastRow Dim lastRow As Long lastRow = Extract.Cells(Rows.Count, "A").End(xlUp).row ' Loop round all rows Dim n As Long For n = 2 To lastRow Cells(n, 3).FormulaR1C1 = _ "=SUMIF(SAPDump!R2C8:R1317C8,Extract!RC[-1],SAPDump!R2C10:R1317C10)*-1" Range("C3").Select Next n ' Insert Title Dim Txt As Range Set Txt = ActiveSheet.Range("C1") Txt.Value = "KeyValue" Txt.Font.Bold = True End Sub 

问题是它真的很慢,有没有人知道使这个运行更快的方法? 干杯