将多个命名范围分配给多个范围数组

Question

我在这里有点新，但这是我想要做的。

我有一本书，假设它是一本用于库存的仓库簿，我们的企业有不同的部门，我有包含所有货物的主表和一些涵盖这些部门的表，用于在它们之间分配货物。

我的想法是为书中的每个项目类型设置一个下拉列表，用于单独的部门，所以我需要宏来为每个项目分配/重新分配命名范围。

I have 2 columns first with stock number and second with serial number ，我需要将所有相同的序列号放入其中一个库存号的命名范围内。如果我有两个或多个序列号，我需要将一组序列号放入一个库存号的指定范围内。 库存编号在 C 列，序列号在 D 列 我试过这段代码

Private Sub CommandButton2_Click()

Dim LastRow As Long
Dim r As Range

LastRow = Cells(Rows.Count, "C").End(xlUp).Row

For Each r In Range("C2:C" & LastRow)
    Range(r.Offset(0, 1), r.Offset(0, 1)).Name = r.Value
Next r
End Sub

但这并不是真正的工作，并且每个指定的库存编号范围只分配一个序列号

================================================ ================== 所以我运行了你在更新版本中提出的这段代码并遇到了一些问题

Private Sub CommandButton2_Click()
    
    Dim this As Worksheet: Set this = Sheets("ALFA")'renamed this for my book'
    Dim that As Worksheet: Set that = Sheets("STORAGE")'renamed that for my book'
    serialNumbers = that.Range(that.Columns(3), that.Columns(4))'Could not find method Unique(and there is no mentions about'
                                                      'it in MS documentation) for Application object so i changed it to just Range'

    
    For r = 2 To this.UsedRange.Rows.Count
        
        buffer = ""
        comma = ""
        stockNumber = this.Cells(r, 3)
            
        For x = 2 To UBound(serialNumbers)
        
            If serialNumbers(x, 1) = stockNumber Then
                buffer = buffer & comma & serialNumbers(x, 2)
                comma = ","
                End If
            
            Next
        
        this.Cells(r, 4).Validation.Delete
        this.Cells(r, 4).Validation.Add _'After doing everything it strucks with Run time error 1004 
            Type:=xlValidateList, _        '/Application-defined or object-defined error in this
            AlertStyle:=xlValidAlertStop, _'hole'
            Formula1:=buffer               'block'
        
        Next
        
End Sub

有时代码只会将我的 excel 应用程序挂起至少 3 分钟，我认为这是因为单元格可以查找没有限制，最终它会尝试对 D:D 中的所有单元格进行验证检查

Answer 1

因此，如果您想设置验证，可以设置动态范围，但验证不接受文本列表，例如“一、二、三”。验证正在寻找一个值数组，不幸的是，仅使用公式传递一个动态数组是很棘手的。您可以将其设置为动态范围，但这必须指向包含所需值的单元格范围，每个单元格都有一个。

但是，在设置所有这些之前，完全在代码中设置验证可能更容易。请参阅this google sheet，其中仅包含供参考的布局。我在工作表的第 1 列和第 2 列（项目、库存号）中有完整的项目列表，在第 5 列和第 6 列（库存号、序列号）中有完整的序列号列表。

然后我运行这段代码：

Sub setValidation()
    
    Dim this As Worksheet: Set this = Sheets("demo")
    Dim that As Worksheet: Set that = Sheets("lookups")
    serialNumbers = Application.Unique(that.Range(that.Columns(5), that.Columns(6)))
    
    For r = 2 To this.UsedRange.Rows.Count
        
        buffer = ""
        comma = ""
        stockNumber = this.Cells(r, 3)
            
        For x = 2 To UBound(serialNumbers)
        
            If serialNumbers(x, 1) = stockNumber Then
                buffer = buffer & comma & serialNumbers(x, 2)
                comma = ","
                End If
            
            Next
        
        this.Cells(r, 4).Validation.Delete
        this.Cells(r, 4).Validation.Add _
            Type:=xlValidateList, _
            AlertStyle:=xlValidAlertStop, _
            Formula1:=buffer
        
        Next
    
End Sub

我们分配了一些工作表变量以便于引用它们，然后将库存号/序列号组合放入一个数组中（使用 UNIQUE，因此我不必检查重复项）。

然后我遍历需要验证的范围（演示第 4 列），从第 3 列获取库存编号，然后使用该库存编号查找所有匹配的序列号，将它们连接成一个字符串，然后使用该字符串设置验证。

在设置验证之前使用 Validation.Delete 以避免堆叠规则。

假设您的 Excel 版本没有 UNIQUE，您可以使用 INTERSECT 来控制 serialNumbers 数组的大小，如下所示：

Sub setValidation()
    
    Dim this As Worksheet: Set this = Sheets("demo")
    Dim that As Worksheet: Set that = Sheets("lookups")
    serialNumbers = Intersect( _
        that.Range(that.Columns(5), that.Columns(6)), _
        that.UsedRange _
    )
    
    For r = 2 To this.UsedRange.Rows.Count
        
        buffer = ""
        comma = ""
        stockNumber = this.Cells(r, 3)
            
        For x = 2 To UBound(serialNumbers)
        
            If serialNumbers(x, 1) = stockNumber Then
                buffer = buffer & comma & serialNumbers(x, 2)
                comma = ","
                End If
            
            Next
        
        this.Cells(r, 4).Validation.Delete
        this.Cells(r, 4).Validation.Add _
            Type:=xlValidateList, _
            AlertStyle:=xlValidAlertStop, _
            Formula1:=buffer
        
        Next
    
End Sub

假设您的 Excel 版本中确实有 UNIQUE 和 FILTER，还有另一种方法可以做到这一点，即使用 EVALUATE 函数访问 Excel 函数引擎。在这种情况下，我们将像在单元格中一样写出一个公式，然后从 VBA 对其进行评估。除非指定，否则评估发生在活动工作表的上下文中，这就是我在此代码中使用的that.evaluate：

Sub setValidation()
    
    Dim expr As String
    Dim this As Worksheet: Set this = Sheets("demo")
    Dim that As Worksheet: Set that = Sheets("lookups")
    
    For r = 2 To this.UsedRange.Rows.Count
        
        stockNumber = this.Cells(r, 3)
        
        expr = "Textjoin("","", true, Unique(Filter(F:F, E:E=""" & stockNumber & """)))"
        serialNumbers = that.Evaluate(expr)
        
        this.Cells(r, 4).Validation.Delete
        this.Cells(r, 4).Validation.Add _
            Type:=xlValidateList, _
            AlertStyle:=xlValidAlertStop, _
            Formula1:=serialNumbers
        
        Next
    
End Sub

在这种情况下，我们使用 FILTER 仅返回与库存号匹配的序列号，使用 UNIQUE 确保没有重复，然后使用 TEXTJOIN 从中创建一个列表，然后我们可以直接传递该结果到验证。

================================================ ====

原始答案显示了如何仅使用 excel 公式获取特定库存编号的所有序列号列表，但很明显这还不够，因为列表将用于设置验证。为了完整起见，留在这里。

所以您有两列，C 和 D，您需要获取 D 中与 C 中的条目匹配的所有值的列表。这实际上很简单，不需要代码，但您可能有更多要求。我将用一组非常基本的公式开始回答。看到这个google sheet。

为了获得唯一的库存编号列表，我在 G1 中使用了UNIQUE(C:C)。这将在 G 列中生成列表。

然后在 H 列中，我使用 TEXTJOIN+UNIQUE+FILTER 生成了一个逗号分隔的序列号列表。 FILTER 采用一个输入数组（在本例中为 Col D）并使用另一个数组（Col C）和一个条件（序列号）对其进行过滤以返回匹配列表，并将其包装在 UNIQUE 中确保结果数组仅包含独特的价值观。将其包装在 TEXTJOIN 中会将结果数组转换为文本。

我不完全清楚的是您需要一个命名范围，或者您将如何处理工作表中的多行。例如，STORAGE 行 35 和 36 都用于 DDG_33：

DDG_33  0BV1111
DDG_33  0AV0951

如果您运行一些代码来生成值列表并将其放入 D35 中，您将拥有：

DDG_33  0BV1111, 0AV0951
DDG_33  0AV0951

但是对于 DDG_33，您仍然有两个条目。如果你再次运行代码，你会得到

DDG_33  0BV1111, 0AV0951, 0AV0951
DDG_33  0AV0951

以此类推，无限循环。似乎您需要获取唯一库存编号列表并将它们与匹配序列号列表一起放在不同的工作表上，但只需说明您想要做什么，我可以更新我的答案。