我正在寻找一种方法来读取多行并创建一个新行，其条目是每行中条目的总和。我在 .Find 的上下文中执行此操作，其中我有一个 33405 x 16 的大型电子表格，一旦 VBA 从我的 strSearch() 数组中找到包含任何字符串的所有行，我想创建一个新的行求和找到的所有行中的每个单元格。
现在我有一种方法可以一次访问每个单元格，但它非常慢（15 分钟）。我希望能够一次操作整行。也许类似于
- 在 strSearch() 中找到第一个元素的第一个实例，复制整行
- 将此行复制到底部的新行
- 从那里，找到 str(Search) 中第二个元素的第一个实例，复制整行
- 将最后一行替换为自身和新行的总和
- 重复直到 strSearch() 中的最后一个元素
- 从这里开始，从 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 上搜索了大约一周，试图找到类似的问题/答案，但无济于事。