删除一列中的重复项,然后在另一列中输入Sum

时间:2019-02-23 10:30:45

标签: excel vba

我想根据第I列中的文本删除重复项,并对C列中的值求和,其他列中的数据都没有关系。

我不需要数据透视表,并且我知道它们是此类事情的首选。

我想要实现的示例:

For this data

To end up like this

我找到了VBA代码并尝试对其进行修改。它不会删除所有行。

<set-configuration-property name='generateJsInteropExports' value='true'/>

2 个答案:

答案 0 :(得分:1)

您要么需要将当前工作表名称更改为 data ,要么更改此代码的前两行以适应您的需求。 sh =您向我们展示的数据表。 osh =此代码将生成的输出工作表。还要注意,如果C列或I列移动,则可以通过更改colBookedcolEstimate轻松地更新位置。如果您有超过一千个唯一的 estimate 条目,则使数组号大于999。

Sub summariseEstimates()
    Dim sh As String: sh = "data"
    Dim osh As String: osh = "summary"
    Dim colBooked As Integer: colBooked = 3
    Dim colEstimate As Integer: colEstimate = 9
    Dim myArray(999) As String
    Dim shCheck As Worksheet
    Dim output As Worksheet
    Dim lastRow As Long
    Dim a As Integer: a = 0
    Dim b As Integer
    Dim r As Long 'row anchor
    Dim i As Integer 'sheets

    'Build summary array:
    With Worksheets(sh)
        lastRow = .Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
        For r = 2 To lastRow
            If r = 2 Then 'first entry
                myArray(a) = .Cells(r, colEstimate) & "," & .Cells(r, colBooked)
            Else
                For b = 0 To a
                    If VBA.LCase(VBA.Replace(.Cells(r, colEstimate), " ", "")) = VBA.LCase(VBA.Replace(VBA.Split(myArray(b), ",")(0), " ", "")) Then 'match
                        myArray(b) = VBA.Split(myArray(b), ",")(0) & "," & VBA.Split(myArray(b), ",")(1) + .Cells(r, colBooked)
                        Exit For
                    End If
                Next b
                If b = a + 1 Then 'completed loop = no match, create new array item:
                    a = a + 1
                    myArray(a) = .Cells(r, colEstimate) & "," & .Cells(r, colBooked)
                End If
            End If
        Next r
    End With

    'Create summary sheet:
    On Error Resume Next
    Set shCheck = Worksheets(osh)
    If Err.Number <> 0 Then
        On Error GoTo 0
        Set output = Worksheets.Add(After:=Worksheets(sh))
        output.Name = osh
        Err.Clear
    Else
        On Error GoTo 0
        If MsgBox("*" & osh & "* sheet already exists. Proceed to delete and recreate?", vbOKCancel, "Summary") = vbCancel Then
            Exit Sub
        Else
            Application.DisplayAlerts = False
            Worksheets(osh).Delete
            Set output = Worksheets.Add(After:=Worksheets(sh))
            output.Name = osh
        End If
    End If

    'Output to summary sheet:
    With Worksheets(osh)
        .Cells(1, 1).Value = "ESTIMATE"
        .Cells(1, 2).Value = "BOOKED THIS WEEK"
        For b = 0 To a
            .Cells(b + 2, 1).Value = VBA.Split(myArray(b), ",")(0)
            .Cells(b + 2, 2).Value = VBA.Split(myArray(b), ",")(1)
        Next b
        .Columns("A:B").AutoFit
    End With

End Sub

答案 1 :(得分:1)

这应该是您的问题的答案。 但是,如果您看起来的范围很长,则可能需要对代码进行修改。

显式选项

function newNameValidation() {
    var newNameValue = $("#NewName").val();
    var nameCount;
    var isFormValid = true;

    $.ajax({
        type: "POST",
        url: "data_process.php",
        data: {
            dataDisplayType: 3,
            newNameValue: newNameValue
        },
        success: function(data) {
            nameCount = data;
            if (nameCount >= 1) {
                showErrorMessage(newNameValue, "Error message");
            } else {
                $("#targetForm").submit();
            }
        },
        error: function() {
            // handle what went wrong with the call and alert the user?
        }
        complete: function() {
            // maybe some cleanup or postprocessing?
        },
    });
};