Question

我正在尝试通过获取一组团队名称并搜索一列已排序的团队名称来格式化导出的工作表。想法是在一组团队名称的第一条记录上方插入新行。问题是我如何搜索该列以从下到上匹配每个团队的第一个值。

我尝试使用数组值进行过滤，并使用行搜索功能将单元格值与数组值进行匹配。

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处经常收到错误消息，上面写着“应用程序定义的错误或对象定义的错误” 。

Answer 1

您没有定义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

Answer 2

两个简单的示例调用

假设团队名称仅在定义的数据范围内出现一次，您可以按照@Scot的建议遍历数据并查找匹配的行，例如通过 Application.Match ，而不是根据teams数组项检查每个单元格。

请注意，VBA遍历范围非常耗时；如果您遍历已转置为“平面” 1维（且基于1） 数组的数据数组（此处为列A1:A200），则可以加快速度，以便允许match 访问数据。

其他提示：建议在任何情况下都在代码模块顶部使用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

将数组值与列单元格值匹配以格式化工作表

2 个答案: