Question

我的工作中有一个跟踪器，该跟踪器从报告中提取信息，然后需要按命名范围为每个用户提取信息。手动执行此操作是一个漫长而乏味的过程-我想知道是否有一种方法可以使它根据列A中两个单元格之间的值自动生成命名范围。

A列中的值会更改，并且不会编号（但它们始终遵循相同的格式）。因此理想情况下，它将只搜索下一个非空单元格。

下面的代码是用于生成命名范围的代码，但是我想知道是否可以根据下一个非空单元格预填充USER1，USER2，RANGE_NAME_USER1等，以便它生成所需的所有范围。

那么，一旦完成对USER1的处理，它将是USER2，USER3，RANGE_NAME_USER2等吗？

我已经尝试了一些while循环等，但是似乎无法弄清楚如何更改“ USER1”，“ USER2”的值以自动知道该怎么做。

Sub SelectBetween()
    Dim findrow As Long, findrow2 As Long
    On Error GoTo errhandler
    findrow = Range("A:A").Find("USER1", Range("A1")).Row
    findrow2 = Range("A:A").Find("USER2", Range("A" & findrow)).Row
    Range("B" & findrow + 1 & ":Q" & findrow2 - 1).Select
    Selection.Name = "RANGE_NAME_USER1"
errhandler:
Exit Sub
    MsgBox "Can't find the cells! Please check!"
End Sub

这个想法是，一旦找到USER1并为其分配了命名范围，它将重复代码，但类似于：

Sub SelectBetween()
    Dim findrow As Long, findrow2 As Long
    On Error GoTo errhandler
    findrow = Range("A:A").Find("USER2", Range("A1")).Row
    findrow2 = Range("A:A").Find("USER3", Range("A" & findrow)).Row
    Range("B" & findrow + 1 & ":Q" & findrow2 - 1).Select
    Selection.Name = "RANGE_NAME_USER2"
errhandler:
Exit Sub
    MsgBox "Can't find the cells! Please check!"
End Sub

这可能吗？谢谢！

Answer 1

认为这可以满足您的需求。它将循环显示范围名称列表，因此请调整为适合同上表名称。

Sub x()

Dim rFind1 As Range, rFind2 As Range, vNames As Variant, i As Long

vNames = Array("USER1", "USER2", "USER3", "RANGE_NAME_USER2")

With Sheet1.Columns(1)
    Set rFind1 = .Cells(.Cells.Count)
    For i = LBound(vNames) To UBound(vNames) - 1
        Set rFind1 = .Find(What:=vNames(i), After:=rFind1, lookat:=xlWhole, SearchDirection:=xlNext, _
                          MatchCase:=False, SearchFormat:=False)
        If Not rFind1 Is Nothing Then
            Set rFind2 = .Find(What:=vNames(i + 1), After:=rFind1)
            If Not rFind2 Is Nothing Then
                .Range("B" & rFind1.Row + 1 & ":Q" & rFind2.Row - 1).Name = vNames(i)
            End If
        End If
    Next i
    .Range("B" & rFind2.Row + 1 & ":Q" & .Cells(Rows.Count, 2).End(xlUp).Row).Name = vNames(UBound(vNames))
End With

End Sub

Answer 2

假定用户已排序，并且用户名作为范围名称的一部分有效，并且您希望将所有用户名都创建为范围名称。

Sub SetUserRanges()

    Dim c As Range, sht As Worksheet
    Dim usr, rngUsers As Range, n As Long

    Set sht = ActiveSheet
    Set rngUsers = sht.Range(sht.Range("A2"), sht.Cells(Rows.Count, 1).End(xlUp))
    Set c = rngUsers.Cells(1)
    Do While c.Row <= rngUsers.Cells(rngUsers.Cells.Count).Row

        usr = c.Value 'current user
        n = Application.CountIf(rngUsers, usr)

        c.Offset(0, 1).Resize(n, 16).Name = Rangename(usr)

        Set c = c.Offset(n, 0)
    Loop

End Sub

'Convert a username formatted as "Agent ####: LastName, FirstName" into 
' "FirstName_LastName"
Function Rangename(usr As String) As String
    Dim arr
    'split on ":" then split second part on ","
    arr = Split(Split(usr, ":")(1), ",")
    Rangename = Trim(arr(1)) & "_" & Trim(arr(0))
End Function

遍历单元格以在VBA / Excel中生成一组命名范围

2 个答案: