时间戳

首页 > 解决方案 > Excel中来自二维矩阵/数组的数据验证列表

excel - Excel中来自二维矩阵/数组的数据验证列表

问题描述

我正在使用技能矩阵为员工制定日常计划。每天，必须安排大约 60 人上班。每个人都被分配了一天的技能。技能矩阵的形状如下：

技能矩阵

然后，对于每一天，根据谁有空，这个想法是允许计划者选择适合该人的技能，以选择他们当天分配的技能。

日常技能分配

理想情况下，他们将能够使用数据验证下拉列表为某人选择适当的技能，该下拉列表仅包含该人有资格获得的技能。

然后，我们可以使用每个技能的计数来创建如下所列的概述。

日常技能概览

理想情况下，可以根据技能矩阵的内容动态地创建用于为每个人选择技能的数据验证列表。我探索了其他帖子和论坛，但还没有找到专门适合这些二维矩阵的解决方案。我发现的最接近的来自这篇文章，但它使用了一种解决方法，其中 OP 提到他们在 VBA 中创建了一种方法来拆分二维矩阵。

所以，我的问题是，是否有办法只使用 Excel 公式（没有 VBA），或者是否有人知道使用 VBA 创建它的方向（我中等熟练度），以便可以添加额外的员工和技能动态到原来的技能矩阵。

编辑：

@FaneDuru，我发现您的代码运行良好，非常感谢！请忽略我之前对“必需”员工的评论，这是一个任意创建的数字。我已经使用了您的 VBA 代码，但我无法让它与我尝试添加的其他方面一起工作。现在我有三张表：第一张是“技能”表，如下所示，类似于我之前分享的内容：

技能表

然后，有一个“可用性”表，其中包含员工（有很多兼职人员）的可用性，看起来像这样：

可用性表

目的是我们每周更新一周日期与员工的可用性。可以看出，本周从未计划过一些员工，因此理想情况下，我们不会在“计划”表中显示他们（类似于您，FaneDuru，构思“列表”表的方式）。因此，“计划”表理想情况下如下所示：

计划表

在这里，我们理想地通过数据验证在人员可用的日子（不可用的日子我用红色突出显示）分配了技能，然后在右边我们有一个每天计数的概述。如您所见，我们最好不要在此计划中显示“酒店”和“Gamma”，因为它们本周不可用。现在我已经手动创建了这些示例表，因为我无法自己正确调整 VBA 代码。

但是，我在调整您的 VBA 代码以便它们不会添加到工作表中以及每天创建五列时遇到问题。您能否就如何实现这一点提出一些建议？再次非常感谢，这意味着一堆！我已经把 VBA 搞了几个小时了，但我对它有点初学者。

标签： excelvbaexcel-formula

解决方案

你没有回答我的澄清问题...

请检查下一个代码解决方案。它使用数组并且应该非常快。它假定矩阵存在于一个名为无论如何命名的工作表中，并且人员列表存在于一个名为“列表”的工作表中。请复制工作表模块中存在矩阵的下一个代码（右键单击工作表名称并选择“查看代码”）：

Option Explicit

Sub makeValidation(rngM As Range, lastR As Long, Target As Range, lastC As Long, Optional boolReset As Boolean)
  Dim shL As Worksheet, lastRL As Long, i As Long, arrV, rngA As Range, arrHead
  Set shL = Worksheets("List")
  lastRL = shL.Range("A" & rows.count).End(xlUp).row
  
  Set rngA = Range("A2:A" & lastR)
  If lastRL <> lastR Then
    If Target.Value <> "xxx" Then
        'update the persons list
        With shL.Range("A2:A" & lastR)
            .ClearContents
            .Value = rngA.Value
        End With
    Else
        Target.ClearContents: Exit Sub
    End If
  End If
  'adapt the validation
  arrV = rngM.Value: arrHead = Range("B1", cells(1, lastC)).Value
  If boolReset Then 'reset all persons range
    For i = 2 To lastR
      setValidation shL.Range("B" & i), arrV, i - 1, arrHead
    Next i
  Else
    'reset anly the modified person skills
    setValidation shL.Range("B" & Target.row), arrV, Target.row - 1, arrHead
  End If
End Sub

Sub setValidation(rngV As Range, arrV As Variant, R As Long, arrHead As Variant)
 Dim listValid As String, arrVal, i As Long
 arrVal = Application.Index(arrV, R, 0) ' slice of row with skills definition

 'find appropriate skills:
 For i = 1 To UBound(arrVal)
    If arrVal(i) = 1 Then listValid = listValid & arrHead(1, i) & ","
 Next i
 listValid = left(listValid, Len(listValid) - 1) 'eliminate last comma

 With rngV.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                       Operator:=xlBetween, Formula1:=listValid
    .IgnoreBlank = True
    .InCellDropdown = True
    .ShowInput = True
    .ShowError = True
 End With
End Sub

它会做以下事情：

  1. 如果任何修改在 "B2" - 范围内，它会自动触发Cells(last row, last column)。我的意思是，它是动态的。如果要添加人员或技能，则代码将在上述范围内添加值 (1) 时运行。

  2. 新添加的人名将复制到“列表”表中，并创建适当的验证

  3. 如果您需要测试/调整列表验证，可以在 A:A 列的任何单元格中写入“xxx”（在保留矩阵的工作表中）。

注意：代码可用于检查是否在上述范围内输入“1”，以警告或将其转换为“1”。代码根据范围内的“1”位置设置技能。但是，在此之前，请测试代码并发送一些反馈。

编辑以落实最后的要求：

  1. 复制标准模块中的下一个代码：
Sub makePlan()
 Dim shM As Worksheet, shAv As Worksheet, shPl As Worksheet, lastRM As Long
 Dim lastRAv As Long, arrM, arrAv, arrPl, i As Long, sh As Worksheet, j As Long
 
 Set shM = Worksheets("Matrix")
 Set shAv = Worksheets("Availability")
 For Each sh In Worksheets
    'identify if sheet "Plan" exists:
    If sh.Name = "Plan" Then Set shPl = sh: Exit For
 Next
 If shPl Is Nothing Then
    'if sheets "Plan" does not exist, it is created:
    Set shPl = Worksheets.Add(After:=shAv)
    shPl.Name = "Plan"
 End If
 If shPl.UsedRange.count > 1 Then shPl.UsedRange.Clear ' clear its content if exists
 lastRM = shM.Range("A" & rows.count).End(xlUp).row    'last row in Matrix sheet
 arrM = shM.Range("A1:F" & lastRM).Value               'fill the matrix in array
 
 lastRAv = shAv.Range("A" & rows.count).End(xlUp).row  'last row in Availability sheet
 arrAv = shAv.Range("A1:F" & lastRAv).Value            'fill the sheet content in array
 
 shPl.Range("A2").Resize(UBound(arrAv), UBound(arrAv, 2)).Value = arrAv 'drop the array content
 shPl.Range("H2").Resize(UBound(arrAv), UBound(arrAv, 2)).Value = arrAv 'drop the array content
 shPl.Columns("A:M").EntireColumn.AutoFit              'auto fit columns
 
 arrPl = shPl.Range("A3:F" & lastRAv + 1).Value 'fill the validation area in array

 'create validation
 For i = 1 To UBound(arrPl)
    If WorksheetFunction.count(shPl.Range("A" & i + 2 & ":F" & 2 + 1)) > 0 Then
        For j = 1 To UBound(arrPl, 2)
            If arrPl(i, j) = 1 Then makeValidation CStr(arrPl(i, 1)), shPl.cells(i + 2, j), arrM ': Exit For
        Next j
    End If
 Next i
 
 'create overview:____________________________________________________________
 Dim arrSk, lastRPl As Long, strForm As String
 
 arrSk = Application.Index(arrM, 1, 0) 'create a first row slice of the arrM array (skills)
 shPl.Range("H2").Resize(UBound(arrSk), 1) = WorksheetFunction.Transpose(arrSk) 'copy skills
 lastRPl = ActiveSheet.Range("A" & rows.count).End(xlUp).row 'last row in Plan sheet
 strForm = "=IF(COUNTIF(B$3:B$" & lastRPl & ",$H3)>0,COUNTIF(B$3:B$" & _
                                                   lastRPl & ",$H3),"""")" 'formula string
 shPl.Range("I3:M" & UBound(arrSk) + 1).ClearContents 'clear contents in the overview area
 shPl.Range("I3").Formula = strForm                   'copy the built formula
 'autofill the formula. Firstly down and then to right:
 shPl.Range("I3").AutoFill Destination:=Range("I3:I" & UBound(arrSk)), _
                                                       Type:=xlFillDefault
 shPl.Range("I3:I" & UBound(arrSk)).AutoFill _
      Destination:=shPl.Range("I3:M" & UBound(arrSk)), Type:=xlFillDefault
 shPl.Range("A1").Value = "Plan of skills per day"
 shPl.Range("H1").Value = "Overview of allocated imployees per day"
 '______________________________________________________________________________
End Sub

Private Sub makeValidation(strPers As String, rngV As Range, arrM As Variant)
 Dim listValid As String, arrVal, arrHead, i As Long, R As Long
 For i = 1 To UBound(arrM)
    If arrM(i, 1) = strPers Then R = i: Exit For 'determine the appropriate row
 Next
 
 arrVal = Application.Index(arrM, R, 0)  ' slice of row with skills definition
 arrHead = Application.Index(arrM, 1, 0) ' headers (skills, in fact)
 'find appropriate skills:
 For i = 1 To UBound(arrVal) ' eliminate spaces:
    If arrVal(i) = 1 Then listValid = listValid & arrHead(i) & ","
 Next i
 listValid = left(listValid, Len(listValid) - 1) 'eliminate last comma
 
 rngV.Value = Split(listValid, ",")(0) 'set the first element as value
 With rngV.Validation 'create validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                       Operator:=xlBetween, Formula1:=listValid
    .IgnoreBlank = True
    .InCellDropdown = True
    .ShowInput = True
    .ShowError = True
 End With
End Sub

  1. 它检查是否存在名为“Plan”的工作表。如果存在，则代码将其清除。如果没有，则插入一个新工作表并命名为“计划”

  2. 必须存在一张名为“Availability”的工作表，看起来像您的图片。它的内容用作构建计划工作表中所有内容的基础。还必须存在一张“矩阵”表（或更改Set shM = Worksheets("Matrix")为保留技能矩阵的现有表）。

  3. 该代码在标有 1 的单元格中创建适当的验证（在“可用性”表中）并选择第一个验证列表选项。然后带上所有能够创建概览的技能和地点公式。

  4. 出于测试原因，代码 (Sub MakePlan()应该从 VBE 运行。它可以从页面上的按钮调用，也可以从事件 ( Worksheet_Change) 调用，以防在特定单元格中写入（特殊）内容。测试后，我可以帮助寻找最适合您的解决方案。

请检查并发送一些反馈，

推荐阅读