Два простых примера звонков
Если предположить, что имена команд появляются в определенном диапазоне данных только один раз, вы можете следовать предложению @ Scot для просмотра данных и поиска соответствующих строк, например, с помощью Application.Match
вместо проверки каждой ячейки на элементы массива teams
.
Примите во внимание, что цикл по диапазону по VBA занимает много времени;Вы ускорите его, если будете проходить через массив данных (здесь: столбец A1:A200
), который был транспонирован в "плоский" 1-мерный (и на основе 1) массив чтобы разрешить match
ing данные.
Дополнительные подсказки: Предложить использовать Option Explicit
в любом случае поверх вашего модуля кода для принудительного объявленияпеременных и для полной квалификации ваших диапазонов ссылок для правильной идентификации рабочих книг и / или рабочих таблиц (в противном случае вы получаете активный лист по умолчанию).
Пример вызова 1 со вставкой строка за строкой
Option Explicit
Sub TestInsert()
Dim ws As Worksheet ' worksheet
Dim team, teams(), data ' variant
Dim foundRow As Variant ' important: declare as Variant to allow IsError check
Dim increment As Long
teams = Array("Team 1", "Team 2", "Team 3", "Team 4", "Team 5", "Team 6", "Team 7", "Team 8", "Team 9")
' assign data in column A to array
Set ws = ThisWorkbook.Worksheets("MySheetName") ' << change to your sheet name
data = Application.Transpose(Application.Index(ws.Range("A1:A200"), 0, 1)) ' assign to a "flat" array (1-based!)
For Each team In teams ' check each team
foundRow = Application.Match(team, data, 0) ' try to find team occurrence in data
If Not IsError(foundRow) Then ' without error a valid row has been found
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Single insertion row by row
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~
ws.Rows(foundRow + increment).EntireRow.Insert ' insert entire row and ...
increment = increment + 1 ' add one row for each following insertion!
End If
Next team
End Sub
Пример вызова 2 с вставкой одной строки кода с использованием Union
Вставка строк с помощью Union
(объединение всех необходимых диапазонов в одном) имеет преимуществочто вы не заботитесь об увеличении строки после каждой новой вставки и можете извлечь выгоду из быстрого выполнения.
Option Explicit
Sub TestIns()
Dim ws As Worksheet ' worksheet
Dim team, teams(), data ' variant
Dim foundRow As Variant ' important: declare as Variant to allow IsError check
Dim rng As Range ' remember all found ranges (combined via Union)
teams = Array("Team 1", "Team 2", "Team 3", "Team 4", "Team 5", _
"Team 6", "Team 7", "Team 8", "Team 9")
' assign data in column A to array
Set ws = ThisWorkbook.Worksheets("MySheetName") ' << change to your sheet name
data = Application.Transpose(Application.Index(ws.Range("A1:A200"), 0, 1)) ' assign to a "flat" array (1-based!)
' check each team and find its row number
For Each team In teams ' check each team
foundRow = Application.Match(team, data, 0) ' try to find team occurrence in data
If Not IsError(foundRow) Then ' a valid row has been found
If rng Is Nothing Then ' first finding?
Set rng = ws.Cells(foundRow, 1) ' remember first cell range, e.g. A2
Else ' next findings
Set rng = Union(rng, ws.Cells(foundRow, 1)) ' add found cell range to other findings
End If
End If
Next team
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' insert all found range rows at once
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
rng.EntireRow.Insert ' insert entire rows to maintain neighbor data
End Sub