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

Question

我正在寻找一种方法来读取多行并创建一个新行，其条目是每行中条目的总和。我在.Find的上下文中执行此操作，其中我有一个大的33405 x 16电子表格，并且一旦VBA查找包含strSearch（）数组中的任何字符串的所有行，我想创建一个新的行累加发现所有行中的每个单元格。

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

1. 东西线查找strSearch（）第一个元素的第一个实例，在底部
2. 整个行
3. 复制此行复制到新行从那里，找到第二一审在STR（搜索）元素，复制整行
4. 与自身strSearch（）
5. 的总和，这新行
6. 重复，直到最后一个元素，从这个地方将最后一行时，重复上述过程第一个元素strSearch（），一直持续到范围的底部。

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

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相当陌生，但我已经搜索了大约一周的谷歌和stackoverflow，试图找到类似的问题/答案无济于事。

Answer 1

让我们试试简单。

不用创建数组并使用VBA，只需使用公式。让我们试试这样的：

1. 为数组中的每个字符串创建一个额外的列[第17,18,19 ...]列。
2. 添加公式：=ISERROR(IF(FIND(<STRING_VALUE>,<STRING_TO_SEARCH>),"X"),"")
3. 综上所述值，你可以创建一个新表如下：

例子：

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>)