創建新範圍，其條目是其他範圍的條目總和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>)