Сопоставление значения массива со значениями ячейки столбца для форматирования листа - PullRequest
0 голосов
/ 28 июня 2019

Я пытаюсь отформатировать экспортированный лист, беря массив названий команд и ища столбец отсортированных названий команд.Идея состоит в том, чтобы вставить новую строку над первой записью набора названий команд.Проблема заключается в том, как найти столбец, чтобы перейти снизу вверх, чтобы соответствовать значению первого значения каждой команды.

Я попытался отфильтровать значения массива и использовать функцию поиска строк, чтобы сопоставить значение ячейки со значением массива.

Dim proteam As String
Dim arr() As Variant
        arr = Array("Team 1", "Team 2", "Team 3", "Team 4", "Team 5", _
              "Team 6", "Team 7", "Team 8", "Team 9")

        For Each cell In Range("A2:A214")
        If UBound(Filter(arr, cell.Value)) > -1 Or UBound(Filter(arr, cell.Value)) > -1 Then

            Rows(Cells(i, 1).Row).Insert shift:=xlUp

            ActiveWorkbook.Close
        End If
     Next

Я получаю сообщение об ошибке на Rows(Cells(i, 1).Row).Insert shift:=xlUp, где говорится «Ошибка приложения или объекта» .

Ответы [ 2 ]

0 голосов
/ 28 июня 2019

Два простых примера звонков

Если предположить, что имена команд появляются в определенном диапазоне данных только один раз, вы можете следовать предложению @ 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

0 голосов
/ 28 июня 2019

Вы не определили I, поэтому вы получили ошибку.Также я изменил Activeworkbook.close на msgbox.Не могу понять, как его использовать.Вы можете добавить его обратно, если требуется.

Используйте это:

Dim proteam As String
Dim arr() As Variant
        arr = Array("Team 1", "Team 2", "Team 3", "Team 4", "Team 5", "Team 6", "Team 7", "Team 8", "Team 9")

        For Each cell In Range("A2:A214")
        If UBound(Filter(arr, cell.Value)) > -1 Or UBound(Filter(arr, cell.Value)) > -1 Then

            Rows(Cells(cell.Row, 1).Row).Insert 

            MsgBox "Macth Found"
        End If
     Next
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...