我不确定你是否尝试过这个,当我发布它作为你昨天的问题的答案时。
当您在 B 列中选择一个单元格时,代码会根据 A 列中的值即时创建验证下拉列表,从而满足您的所有需求。下拉列表会根据语言显示产品代码和说明。选择产品代码并从单元格中删除验证后,说明将被删除。
虽然代码确实完成了您需要的所有工作,但它并不完美,但它为您提供了一个巨大的开端,并且如果您复制并粘贴它并尝试一下,它应该可以与您的工作表名称等一起使用。
Dim CHANGING_VAL As Boolean 'Global Variable that can be set to prevent the onchange being fired when the Macro is removing the description from the dropdown.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 2 And CHANGING_VAL = False Then
CHANGING_VAL = True
If InStr(1, Target.Value, "~") > 2 Then
Target.Value = Left(Target.Value, InStr(1, Target.Value, "~") - 2)
End If
Target.Validation.Delete
Target.Font.Color = RGB(0, 0, 255)
CHANGING_VAL = False
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 2 Then
If Target.Offset(0, -1) <> "" Then
strValidList = ""
For intRow = 1 To 10000
If Sheets("Parts").Cells(intRow, 1) = Target.Offset(0, -1) Then
If Sheets(Target.Parent.Name).Cells(3, 4) = "English" Then
strValidList = strValidList & Sheets("Parts").Cells(intRow, 2) & " ~ " & Sheets("Parts").Cells(intRow, 3) & ", "
Else
strValidList = strValidList & Sheets("Parts").Cells(intRow, 2) & " ~ " & Sheets("Parts").Cells(intRow, 4) & ", "
End If
End If
Next
If strValidList <> "" Then
strValidList = Left(strValidList, Len(strValidList) - 2)
Target.Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=strValidList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End If
Else
Sheets(Target.Parent.Name).Range("B:B").Validation.Delete
End If
End Sub