SUMIF和多张表

时间:2015-05-29 13:00:04

标签: excel vba excel-vba excel-2010

我正在为多个工作表搜索一个字符串,一旦找到该字符串,就会将其复制到MergedData工作表。

第1列是付款编号,例如50。第2列是工单号11111。列“3,4,5,6,7,8”或其他信息。 “9,10,12”是£值。

当复制此数据时,第2列中的工单号可能有多个实例。我需要有一个SUMIF来查找第2列中的任何重复项并总结“9,10&amp; 12”列。< / p>

我已经设法获得SUMIF的代码,但是在复制数据之后我似乎无法使其工作。

我需要发生的是,当您单击按钮时,它会搜索字符串,并将其复制到MergedData工作表,并在复制完所有数据后单击同一按钮以执行SUMIF功能。

非常感谢您提供的任何帮助!

这是我用来将多张表中的数据复制到一张中的代码:

Private Sub CommandButton1_Click()    Dim FirstAddress As String, WhatFor As String
Dim Cell As Range, Sheet As Worksheet
Dim sSheetsWithData As String, sSheetsWithoutData As String
Dim lSheetRowsCopied As Long, lAllRowsCopied As Long
Dim bFound As Boolean
Dim sOutput As String

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .CutCopyMode = False
End With

WhatFor = Sheets("SUB CON PAYMENT FORM").Range("L9")

Worksheets("MergedData").Cells.ClearContents

If WhatFor = Empty Then Exit Sub

For Each Sheet In Sheets
    If Sheet.Name <> "SUB CON PAYMENT FORM" And Sheet.Name <> "MergedData" And Sheet.Name <> "Details" Then
        bFound = False
        With Sheet.Columns(1)
            Set Cell = .Find(WhatFor, LookIn:=xlValues, LookAt:=xlWhole)
            If Not Cell Is Nothing Then
                bFound = True
                lSheetRowsCopied = 0
                FirstAddress = Cell.Address
                Do
                    lSheetRowsCopied = lSheetRowsCopied + 1
                    Cell.EntireRow.Copy
                    ActiveWorkbook.Sheets("MergedData").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlValues
                    Set Cell = .FindNext(Cell)
                Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
            Else
                bFound = False
            End If
            If bFound Then
                sSheetsWithData = sSheetsWithData & "    " & Sheet.Name & " (" & lSheetRowsCopied & ")" & vbLf
                lAllRowsCopied = lAllRowsCopied + lSheetRowsCopied
            Else
                sSheetsWithoutData = sSheetsWithoutData & "    " & Sheet.Name & vbLf
            End If
        End With
    End If
Next Sheet

If sSheetsWithData <> vbNullString Then
    sOutput = "Sheets with data copied (# of rows)" & vbLf & vbLf & sSheetsWithData & vbLf & _
        "Total rows copied = " & lAllRowsCopied & vbLf & vbLf
Else
    sOutput = "No sheeTs contained data to be copied" & vbLf & vbLf
End If

If sSheetsWithoutData <> vbNullString Then
    sOutput = sOutput & "Sheets with no rows copied:" & vbLf & vbLf & sSheetsWithoutData
Else
    sOutput = sOutput & "All sheets had data that was copied."
End If

If sOutput <> vbNullString Then MsgBox sOutput, , "Copy Report"

With Worksheets("MergedData")
    If .Cells(1, 1).Value = vbNullString Then .Rows(1).Delete
End With

Set Cell = Nothing
End Sub

这是我用于SUMIF的另一段代码:

Sub combineduplicates()                 '### starts our macroApplication.ScreenUpdating = False      '### Excel wont update its screen while executing this macro. This is a huge performace boost
Dim SUMcols()                         '### declare a second empty array for our sum columns


SUMcols() = Array(9, 10, 12)         '### the second array stores the columns which should be summed up


'### the next line sets our range for searching dublicates. Starting at cell A2 and ending at the last used cell in column A
Set searchrange = Range([b2], Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious))
For Each cell In searchrange            '### now we start looping through each cell of our searchrange

Set search = searchrange.Find(cell, after:=cell, lookat:=xlWhole)   '### searches for a dublicate. If no dub exists, it finds only itself
Do While search.Address <> cell.Address     '### until we find our starting cell again, these rows are all dublicates

    For i = 0 To UBound(SUMcols)    '### loop through all columns for calculating the sum
        '### next line sums up the cell in our starting row and its counterpart in its dublicate row
        Cells(cell.Row, SUMcols(i)) = CDbl(Cells(cell.Row, SUMcols(i))) + CDbl(Cells(search.Row, SUMcols(i)))
    Next i                          '### go ahead to the next column


    search.EntireRow.Delete         '### we are finished with this row. Delete the whole row
    Set search = searchrange.Find(cell, after:=cell)    '### and search the next dublicate after our starting row
Loop

Next                                    '### from here we start over with the next cell of our searchrange
                                    '### Note: This is a NEW unique value since we already deleted all old dublicates
Application.ScreenUpdating = True       '### re-enable our screen updating

End Sub                                 '### ends our macro

0 个答案:

没有答案