根据2个条件求和,然后在求和后

时间:2018-01-16 23:34:46

标签: excel-vba vba excel

在下面的示例数据中,如果(1)A列中的安全性重复,并且(2)B列中的描述显示“收入”和“特殊现金”,我试图对费率求和。然后取总和并替换第1行C列中的速率值。最后,删除不再需要的第3行。

         Column A        Column B         Column C
(Row 1) BIT US Equity    Income           .1167
(Row 2) BIT US Equity    ST Cap Gain      .1110
(Row 3) BIT US Equity    Special Cash     .13105
(Row 4) AOL US Equity    Regular Cash     .12345
(Row 5) RAC US Equity    LT Cap Gain      .10005

非常感谢任何反馈!

1 个答案:

答案 0 :(得分:0)

如果我正确理解了您的问题,那么以下内容应该符合您的期望:

Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A

For i = 1 To LastRow 'loop from row 1 to last
    CheckValue = ws.Cells(i, 1) 'get the value from Column A
    For x = 1 To LastRow 'do a second loop to check if we find any cell in Column B with "Special Cash"
        If ws.Cells(x, 2) = "Special Cash" And ws.Cells(x, 1) = CheckValue Then ' if Special Cash found and there is another cell with the same Column A value
            ws.Cells(x, 2) = "Income" 'replace Special Cash with Income
        End If
    Next x
Next i
    ws.Cells(1, 4).FormulaR1C1 = "=SUMIFS(C[-1],C[-3],RC[-3],C[-2],RC[-2])"
    'add sum formula to column D
    ws.Range("D1:D" & LastRow).FillDown
    'fill the formula to the lastrow
    ws.Range("D1:D" & LastRow).Copy
    'copy values returned by formula
    ws.Range("D1:D" & LastRow).PasteSpecial xlPasteValues
    'paste the values and get rid of formula
    ws.Columns("C:C").Delete Shift:=xlToLeft
    'delete column C and bring Column D into its place
    Range("$A$1:$C$" & LastRow).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo
    'remove duplicates
End Sub