SUMIF как макрос в Excel (VBA)

Question

Итак, это концепция, с которой я работаю.

У меня есть Лист1 со многими ключами и значениями на нем:

Тогда на sheet2 я использую функцию SUMIF выработать общие значения из sheet1:

Это всего лишь пример, и фактические наборы данных намного больше. Мне нужно создать макрос, который будет автоматически генерировать и вставлять формулу SUMIF в правильные ячейки в sheet2. Может ли кто-нибудь подумать о том, как это сделать?

Answer 1

Я бы прочитал данные с листа один, а затем построил второй лист. Вам нужно будет добавить ссылку для набора записей adodb. В среде VBA IDE в раскрывающемся меню инструментов выберите ссылки. Выберите «Microsoft ActiveX Data Objects 2.8 Library».

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 

Answer 2

Решение проблемы.

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 

Предполагается, что столбец A на листе 2 уже установлен. Также предполагается, что Заголовок для столбца B на листе2 уже установлен, а остальная колонка B пуста и будет заполнена вышеуказанным кодом.

Он также принимает цифровые клавиши.

Это решение может быть легко отрегулировано, если какие-либо допущения ошибочны. Просто дай мне знать.

Answer 3

Даже не зная никаких других требований, или то, что вы делаете или сколько столбцов или ключей есть или что-нибудь еще, вы можете:

1. запись макроса,
2. назначить его на кнопку,
3. напишите одну строку кода, чтобы , что при нажатии пользователем кнопки выполняется макрос на выбранном столбце (или когда выбрана первая ячейка столбца).

Если есть более 100 столбцов, то да, это утомительно, и вы хотите, чтобы макрос все это просматривал, но я понятия не имею, что вам нужно.

Answer 4

Это то, что я в конце концов:

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 

Проблема заключается в том, что это очень медленно, кто-нибудь знает способ сделать это запустить быстрее? ура