创造价值

Question

这很复杂，我不知道如何得到我想要的。我可以单独完成，但这违背了我试图弄清楚的代码的目的。

我想让它在给定的范围内搜索，一旦找到它的值，找到它的重合值，不管有多少行，把它们加起来，然后在重合的单元格中输出第一个值和第二个值。甚至可以放到不同的床单上。

如果你能理解我输入的内容，我会为你鼓掌，因为我知道这可能会让你感到困惑和/或你不理解。所以我会尝试通过发布我想要的截图来澄清(就像我说的，你可以手动完成，但是谁想通过100+列搜索呢？)

示例：

​

不管是一个实例还是50个实例，我都想把这些值加起来。

Answer 1

这是一个将摘要复制到新工作表的VBA解决方案。使用.Sort和.Subtotal。代码中有一个“设置”部分，您可以根据自己的情况/要求进行自定义。

有几点：

您将需要在数据的顶部插入一行，并添加一些列标题(这些是.SubTotal方法所必需的)。

您可以将小计格式保留在原始数据中(可能对检查/审计有用？)或者删除它们(参见代码中的注释)。

数据和结果摘要都将按字母顺序排列。

如果调整代码以将摘要粘贴到原始工作表中，请务必小心( .SubTotal方法隐藏行！)。

Option Explicit

Sub STot()
Dim dataws As Worksheet, destws As Worksheet
Dim drng As Range
Dim strow As Long, endrow As Long, stcol As Long, endcol As Long
Dim filtrows As Long, modcell As Long
Dim cpyrow As Long, cpycol As Long

'Setup ==========================
'data and destination worksheets
Set dataws = Sheets("Sheet1")
Set destws = Sheets("Sheet3")

'position of data on dataws
strow = 1
stcol = 1  'Col A

'cell position to copy - on new worksheet (destws)
cpyrow = 2
cpycol = 3
'End of setup ===================

    With dataws
        'find last data row/column
        endrow = Cells(Rows.Count, stcol).End(xlUp).Row
        endcol = Cells(stcol, Columns.Count).End(xlToLeft).Column

        'sort data
        Set drng = .Range(.Cells(strow, stcol), .Cells(endrow, endcol))
        drng.Sort Key1:=.Cells(strow, stcol), Order1:=xlAscending, Header:=xlYes

        'apply Excel SubTotal function
        drng.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=2

        'collapse Subtotal levels to show summary
        .Outline.ShowLevels 2

        ' copy results to another worksheet
        drng.SpecialCells(xlCellTypeVisible).Copy Destination:=destws.Cells(cpyrow, cpycol)

        'if you want to remove subtotals from original data
        .Cells.RemoveSubtotal
    End With

    'tidy-up output on destination worksheet
    With destws
        'remove headings
        .Cells(cpyrow, cpycol).Resize(2, 2).Delete (xlShiftUp)
        'remove "Total" string in each name
        Do While Not (IsEmpty(.Cells(cpyrow, cpycol).Value))
            .Cells(cpyrow, cpycol).Value = Left(.Cells(cpyrow, cpycol).Value, InStr(1, .Cells(cpyrow, cpycol).Value, " ") - 1)
            cpyrow = cpyrow + 1
        Loop
    End With

End Sub