创build新的范围，其条目是其他范围VBA的条目总和

我正在寻找一种方法来读取多行，并创build一个新的行，其条目是每行中的条目总和。 我正在做一个.Find的上下文，我有一个大的33405 x 16电子表格，一旦VBAfind包含我的strSearch（）数组中的任何string的所有行，我想创build一个新的行总结发现所有行中的每个单元格。

现在我有办法做到这一点，一次访问每个单元格，但是它非常慢（15分钟）。 我希望能够一次处理整行。 也许是沿着这条线

1. 在strSearch（）中查找第一个元素的第一个实例，复制整个行
2. 将此行复制到底部的新行
3. 从那里，findstr（Search）中第二个元素的第一个实例，复制整行
4. 用自己和这个新行的总和replace最后一行
5. 重复直到strSearch（）中的最后一个元素
6. 从这个地方，重复从strSearch（）中的第一个元素的过程，直到范围的底部。

我现在的代码如下。 这样做是findstrSearch（）中第一个string的每个实例的行号，并将这些行复制到底部。 然后，它findstrSearch（）中每个string2的实例的行号，并将这些行添加到底部的行（逐个单元格）（因此电子表格中的最后一行现在是最后一行string1和string2的实例）。 电子表格每行的前五个单元格是指定位置的string，然后一行中的剩余单元格是长整型的。

Private Function Add_Industries(sheetName As String, strSearch() As Variant, yearsNaicsData As Integer, newIndustry As Long) Application.ScreenUpdating = False Dim i As Integer, _ j As Integer Dim rngSearch As range Dim firstAddress As String Worksheets(sheetName).Activate With Worksheets(sheetName).range("D:D") For k = 0 To UBound(strSearch) j = 0 Set rngSearch = .Find(strSearch(k), .Cells(1), xlValues, xlWhole) If Not rngSearch Is Nothing Then firstAddress = rngSearch.Address Do If k = 0 Then 'Add the first listings Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1) = Cells(rngSearch.Cells.Row, 1) Cells(ActiveSheet.UsedRange.Rows.Count, 2) = Cells(rngSearch.Cells.Row, 2) Cells(ActiveSheet.UsedRange.Rows.Count, 3) = Cells(rngSearch.Cells.Row, 3) Cells(ActiveSheet.UsedRange.Rows.Count, 4) = newIndustry Cells(ActiveSheet.UsedRange.Rows.Count, 5) = Cells(rngSearch.Cells.Row, 5) For i = 6 To 6 + yearsNaicsData - 1 Cells(ActiveSheet.UsedRange.Rows.Count, i) = Cells(rngSearch.Cells.Row, i) Next Else 'Sum up the rest of the listings For i = 6 To 6 + yearsNaicsData - 1 Cells(ActiveSheet.UsedRange.Rows.Count - (254 - j), i) = Cells(ActiveSheet.UsedRange.Rows.Count - (254 - j), i) + Cells(rngSearch.Cells.Row, i) Next j = j + 1 End If Set rngSearch = .FindNext(rngSearch) 'Find the next instance Loop While Not rngSearch Is Nothing And rngSearch.Address <> firstAddress End If Next End With 

在尝试读取和操作整行时，我已经搞乱了集合，但是这个代码不能很好地工作，我不知道要在Else（k <> 0）语句中放置什么来获取我想要的结果。

 Private Function Add_Industries2(sheetName As String, strSearch() As Variant, yearsNaicsData As Integer, newIndustry As Long) Application.ScreenUpdating = False Dim i As Integer, _ j As Integer, _ k As Integer Dim rngSearch As range Dim cl As Collection Dim buf_in() As Variant Dim buf_out() As Variant Dim val As Variant Dim firstAddress As String Worksheets(sheetName).Activate With Worksheets(sheetName).range("D:D") k = 0 Set rngSearch = .Find(strSearch(k), .Cells(1), xlValues, xlWhole) If Not rngSearch Is Nothing Then firstAddress = rngSearch.Address Set cl = New Collection Do For k = 0 To UBound(strSearch) Set buf_in = Nothing buf_in = Rows(rngSearch.Row).Value If k = 0 Then For Each val In buf_in cl.Add val Next Else 'Somehow add the new values from buff_in to the values in the collection? End If ReDim buf_out(1 To 1, 1 To cl.Count) Rows(ActiveSheet.UsedRange.Rows.Count + 1).Resize(1, cl.Count).Value = buf_out Cells(ActiveSheet.UsedRange.Rows.Count, 4) = newIndustry If k + 1 <= UBound(strSearch) Then Set rngSearch = .Find(strSearch(k + 1), .Cells(rngSearch.Cells.Row), xlValues, xlWhole) Else Set rngSearch = .Find(strSearch(0), .Cells(rngSearch.Cells.Row), xlValues, xlWhole) k = 0 End If Next Loop While Not rngSearch Is Nothing And rngSearch.Address <> firstAddress End If End With End Function 

对不起，如果这是模糊的，希望有一个更快的方法来做到这一点！ 我相当新的VBA，但我已经search了谷歌和stackoverflow大约一个星期，试图find一个类似的问题/答案无济于事。

Answer 1

让我们尝试一下轻松。

而不是创build一个数组，并使用VBA，你可以只使用公式。 让我们尝试这样的事情：

1. 为数组中的每个string创build一个额外的列[Column 17，18，19 …]。
2. 添加公式： =ISERROR(IF(FIND(<STRING_VALUE>,<STRING_TO_SEARCH>),"X"),"")
3. 总结这个值，你可以创build一个像这样的新表：

例：

 Column 1 Column 2 <STRING_VALUE_1> =SUMIF(Columns(17),"X",<Column_To_SUM>) <STRING_VALUE_2> =SUMIF(Columns(18),"X",<Column_To_SUM>) <STRING_VALUE_3> =SUMIF(Columns(19),"X",<Column_To_SUM>)