如果列名与数据validation匹配，则扩展VB代码以填充Excel单元格

我们目前的Excel工作簿中有一些VB代码，允许多选数据validation（列表下拉）选项，然后对于从列表中select的每个下拉项目，它在行的末尾输出选项，一个选项每列。

即：从下拉列表中select苹果，香蕉和樱桃将输出苹果| 香蕉| 樱桃（其中|是列分隔符）在第一个单元格为空的行末尾。

我们的代码是：

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo exitHandler Dim rngDV As Range Dim iCol As Integer If Target.Count > 1 Then GoTo exitHandler On Error Resume Next Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) On Error GoTo exitHandler If rngDV Is Nothing Then GoTo exitHandler If Intersect(Target, rngDV) Is Nothing Then 'do nothing Else Application.EnableEvents = False If Target.Column = 3 Then If Target.Value = "" Then GoTo exitHandler If Target.Validation.Value = True Then iCol = Cells(Target.Row, Columns.Count).End(xlToLeft).Column + 1 Cells(Target.Row, iCol).Value = Target.Value Else MsgBox "Invalid entry" Target.Activate End If End If End If exitHandler: Application.EnableEvents = True End Sub 

然而，我们想在这个VB代码中修改，而不是在select数据validation的行尾填充单元格。 我们希望在列标题与从下拉列表中select的选项相匹配的列下填充单元格。

即：在下拉菜单中select的苹果将填满该行上的单元格，标记为“苹果”。 在下拉菜单中select的樱桃将填满标签为“樱桃”的列下方的单元格。 理想情况下，通过填充，我们可以为单元格着色或在其中放置X，而不是重复所选项目的名称。

如果任何人可以build议我们需要在上面的代码修改，这将不胜感激。

Answer 1

我已经修改了你的代码，按照你的要求，它遍历列标题find正确的列，然后改变适当的单元格的背景颜色。
更新：添加了一个检查，以防止无限循环。

 Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo exitHandler Dim rngDV As Range Dim iCol As Integer, iColumnHeaderRow As Integer iColumnHeaderRow = 3 'change this if header row changes If Target.Count > 1 Then GoTo exitHandler On Error Resume Next Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) On Error GoTo exitHandler If rngDV Is Nothing Then GoTo exitHandler If Not Intersect(Target, rngDV) Is Nothing Then Application.EnableEvents = False If Target.Column = 3 Then If Target.Value = "" Then GoTo exitHandler If Target.Validation.Value = True Then 'iterate through column headers to find the matching column iCol = (Target.Column + 1) Do Until Cells(iColumnHeaderRow, iCol).Value = Target.Value iCol = iCol + 1 'if we've hit a blank cell in the header row, exit '(also to prevent an infinite loop here) If Cells(iColumnHeaderRow, iCol).Value = "" Then GoTo exitHandler Loop 'set fill color of appropriate cell With Cells(Target.Row, iCol).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent6 .TintAndShade = 0.599993896298105 .PatternTintAndShade = 0 End With Else MsgBox "Invalid entry" Target.Activate End If End If End If exitHandler: Application.EnableEvents = True End Sub 

Answer 2

替代

 Cells(Target.Row, iCol).Value = Target.Value 

对于

 Cells(Target.Row, Range(Target.Value).Column).Value = "X" 

当心：只有在您为标题单元命名的情况下才能使用。 Range("Banana") ，例如，将提到你给的名字“香蕉”的单元格。

要指定名称，请使用屏幕左上方的文本框。 该文本框最初只包含单元格坐标，如“A1”，“B2”等。 点击您想要命名的标题单元格，转到此文本框并键入“Banana”或任何其他与您的下拉值相匹配的名称。 将所有标题命名为所有下拉列表（缺less一个会导致错误）。

（你可以放弃那个iCol计算）