Я пытаюсь получить файл Excel с выпадающими столбцами, и я бы не хотел, чтобы люди копировали и вставляли эти столбцы.Но если значение, которое они вставляют, является правильным, тогда они могут вставить.
Код, который я имею, работает для одного столбца.Я пытаюсь сделать для нескольких столбцов с разными раскрывающимися списками каждый.
В этом примере кода это только для двух столбцов (C и D) с раскрывающимися списками в «раскрывающихся списках» в столбцах A и B соответственно.
Любая помощь в том, как изменить приведенный ниже код, чтобы он работал для большего количества столбцов?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Dim isect As Range
Dim isect2 As Range
Dim cell As Range
Dim dd() As Variant
Dim i As Long
Dim mtch As Boolean
Dim msg As String
Dim myEntries As String
Dim ddRange As Range
Dim ddRange2 As Range
Set rng1 = Range("C:C")
Set rng2 = Range("D:D")
Set ddRange = Sheets("Dropdowns").Range("A2:A11")
Set ddRange2 = Sheets("Dropdowns").Range("B2:B8")
Set isect = Intersect(rng1, Target)
Set isect2 = Intersect(rng2, Target)
If (isect Is Nothing) And (isect2 Is Nothing) Then Exit Sub
Application.EnableEvents = False
If Not isect Is Nothing Then
ReDim dd(ddRange.Cells.Count)
i = 0
For Each cell In ddRange
dd(i) = cell.Value
i = i + 1
Next cell
For Each cell In isect
mtch = False
For i = LBound(dd) To UBound(dd)
If cell.Value = dd(i) Then
mtch = True
Exit For
End If
Next i
If mtch = False Then
cell.ClearContents
msg = msg & cell.Address(0, 0) & ","
End If
Next cell
For i = LBound(dd) To UBound(dd)
myEntries = myEntries & dd(i) & ","
Next i
myEntries = Left(myEntries, Len(myEntries) - 1)
With rng1.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=myEntries
End With
If Len(msg) > 0 Then
MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
End If
End If
If Not isect2 Is Nothing Then
For Each cell In isect2
If (Len(cell) > 0) And (Len(cell) <> 11) Then
cell.ClearContents
msg = msg & cell.Address(0, 0) & ","
End If
Next cell
With rng2.Validation
.Delete
.Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, _
Operator:=xlEqual, Formula1:="11"
End With
If Len(msg) > 0 Then
MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
End If
End If
Application.EnableEvents = True
End Sub
Я пытался создать функцию и каждый столбец с раскрывающимся списком для вызова этой функции.с соответствующими правильными выпадающими списками.
Это правильный подход?Любая помощь в этом?
Спасибо заранее за ваше время !!