總和和組VBA片

Question

我一個項目完成，我已經有一些模板，我需要一羣庫存...的信息是這樣的：

，我需要總結casedocs和調用數列，得到這樣的使用VBA代碼：

我不知道如何使它可能的...什麼建議嗎？

Answer 1

SQL是理想的分組和求和數據。在這個例子中，我使用ADODB連接來分組和彙總數據。

Sub CreateConsolidatedTable() 
    Const adOpenKeyset = 1 
    Const adLockOptimistic = 3 
    Const WORKSHEETNAME As String = "Sheet1" 
    Const TABLENAME As String = "Table1" 

    Dim conn As Object, rs As Object 
    Dim tbl As ListObject 
    Dim Destination As Range 
    Set Destination = Worksheets.Add.Range("A1") 

    Set tbl = Worksheets(WORKSHEETNAME).ListObjects(TABLENAME) 

    Set conn = CreateObject("ADODB.Connection") 
    conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";" 

    conn.Open 
    ' On Error GoTo CloseConnection 
    Set rs = CreateObject("ADODB.Recordset") 
    With rs 
     .ActiveConnection = conn 
     .CursorType = adOpenKeyset 
     .LockType = adLockOptimistic 
     .Source = getSQL(tbl) 
     .Open 

     With Destination 
      tbl.HeaderRowRange.Copy .Range("A1") 
      .Range("A2").CopyFromRecordset rs 
      .Parent.ListObjects.Add SourceType:=xlSrcRange, Source:=.Range("A1").CurrentRegion, XlListObjectHasHeaders:=xlYes, TableStyleName:=tbl.TableStyle 

     End With 
    End With 
CloseRecordset: 
    rs.Close 
    Set rs = Nothing 
CloseConnection: 
    conn.Close 
    Set conn = Nothing 
End Sub 

Function getSQL(tbl As ListObject) As String 
    Dim SQL As String, SheetName As String, RangeAddress As String 
    SQL = "SELECT DISTINCTROW [LastName], [FirstName], [Agent ID], Sum([Case Docs]) AS [Sum Of Case Docs], Sum([Call Count]) AS [Sum Of Call Count]" & _ 
      " FROM [SheetName$RangeAddress]" & _ 
      " GROUP BY [LastName], [FirstName], [Agent ID];" 

    SheetName = tbl.Parent.Name 
    RangeAddress = tbl.Range.Address(False, False) 

    SQL = Replace(SQL, "SheetName", SheetName) 
    SQL = Replace(SQL, "RangeAddress", RangeAddress) 

    getSQL = SQL 
End Function 

Answer 2

試試這個：

Sub Subroutine() 
Dim currentrow As Integer 
currentrow = 1 
For i = 1 To 500 
    If Cells(currentrow, 8) = Cells(i, 2) Then 
     Cells(currentrow, 10) = Cells(currentrow, 10) + Cells(i, 4) 
     Cells(currentrow, 11) = Cells(currentrow, 11) + Cells(i, 5) 
    ElseIf IsNull(Cells(i, 2)) Or Cells(i, 2) = "" Then 
     Exit For 
    Else 
     currentrow = currentrow + 1 
     Cells(currentrow, 7) = Cells(i, 1) 
     Cells(currentrow, 8) = Cells(i, 2) 
     Cells(currentrow, 9) = Cells(i, 3) 
     Cells(currentrow, 10) = Cells(i, 4) 
     Cells(currentrow, 11) = Cells(i, 5) 
    End If 
Next i 
End Sub 

你必須要調整單元格的座標，以配合您的細胞的座標。

Answer 3

子consolidateData（）

昏暗lRow只要 昏暗ItemRow1，ItemRow2作爲字符串 昏暗lengthRow1，lengthRow2作爲字符串

lRow = 3 
Do While (Cells(lRow, 1) <> "") 

    ItemRow1 = Cells(lRow, "A") 
    ItemRow2 = Cells(lRow + 1, "A") 

    lengthRow1 = Cells(lRow, "B") 
    lengthRow2 = Cells(lRow + 1, "B") 

    If ((ItemRow1 = ItemRow2) And (lengthRow1 = lengthRow2)) Then 
     Cells(lRow, "D") = Cells(lRow, "D") + Cells(lRow + 1, "D") 

     Cells(lRow, "E") = Cells(lRow, "E") + Cells(lRow + 1, "E") 
     Rows(lRow + 1).Delete 

    Else 
     lRow = lRow + 1 
    End If 

Loop 

結束子