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

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循环循环是很耗时的；如果您通过数据阵列循环(此处：A1:A200列(，该速度已将其转换为" flat" 1二维(和1个基于1的( array 为了允许 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

插入一个代码行的插入2

通过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