时间戳

首页 > 解决方案 > 循环遍历单元格以在 VBA/Excel 中生成一组命名范围

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

问题描述

我的工作中有一个跟踪器，它从报告中提取信息，然后需要根据命名范围为每个用户提取信息。手动操作是一个漫长而乏味的过程 - 我想知道是否有办法让它根据 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

这可能吗？谢谢！

标签： excelvba

解决方案

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

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

推荐阅读