複数の行を読み取り、各行のエントリの合計をエントリとする新しい行を作成する方法を探しています。私は .Find のコンテキストでこれを行っています。ここでは、33405 x 16 の大きなスプレッドシートがあり、VBA が strSearch() 配列の文字列を含むすべての行を見つけたら、新しい行の合計を作成したいと考えています。見つかったすべての行の各セル。
現在、一度に各セルにアクセスする方法がありますが、非常に時間がかかります (15 分)。行全体を一度に操作できるようにしたいと思います。おそらく、その線に沿った何か
- strSearch() で最初の要素の最初のインスタンスを検索し、行全体にコピーします
- この行を一番下の新しい行にコピーします
- そこから、str(Search) で 2 番目の要素の最初のインスタンスを見つけ、行全体をコピーします。
- 最後の行をそれ自体とこの新しい行の合計に置き換えます
- strSearch() の最後の要素まで繰り返す
- この場所から、strSearch() の最初の要素からプロセスを繰り返し、範囲の最後まで続けます。
私が持っている現在のコードは以下のとおりです。これが行うことは、strSearch() で最初の文字列のすべてのインスタンスの行番号を見つけ、それらの行を一番下にコピーすることです。次に、strSearch() で文字列 2 のすべてのインスタンスの行番号を見つけ、それらの行を一番下の行にセルごとに追加します (したがって、スプレッドシートの最後の行は、最後の行に対応する行の項目ごとの合計になります)。 string1 と string2 のインスタンス)。スプレッドシートの各行の最初の 5 つのセルは場所を指定する文字列で、行の残りのセルは long です。
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にかなり慣れていませんが、Googleとstackoverflow全体を約1週間検索して、同様の質問/回答を見つけようとしましたが、役に立ちませんでした。