Question

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

现在我有办法一次访问每个单元格，但速度非常慢（15分钟）。我希望能够一次操作整行。

可能是一些东西

在strSearch（）中查找第一个元素的第一个实例，复制整行
将此行复制到底部的新行
从那里，在str（搜索）中找到第二个元素的第一个实例，在整行中复制
将最后一行替换为其自身和此新行的总和
重复直到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＆lt;＆gt; 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相当新，但我搜索了整个google和stackoverflow大约一个星期，试图找到类似的问题/答案无济于事。

Answer 1

让我们尝试一些简单的事情。

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

为数组中的每个字符串创建一个额外的列[第17,18,19 ...列。
添加公式：=ISERROR(IF(FIND(<STRING_VALUE>,<STRING_TO_SEARCH>),"X"),"")
要对值求和，您可以创建一个如下所示的新表：

示例：

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

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

1 个答案: