0
내가 골 H는내부 선택 케이스
골 A는 이미 검증 목록은 동적를 사용하여 사용하도록 설정되어 골의 A.에 의존 드롭 다운 상자해야 페이지를 구축하고의 이름이 지정된 범위는 Data라는 숨겨진 시트에 지정됩니다.
또한 데이터 시트에서 Col A에 종속적 인 3 개의 목록을 지정했으며 이미 동적 명명 된 범위로 지정했습니다.
지금까지, VB 코드에서, 나는
이 골 (A)에 만들어진 선택에서 쉼표하기 전에, 첫 번째 단어를 찍은 것을 사용이 내 "그룹"식별자.
Col B에 입력 한 모든 텍스트를 대문자로 표시합니다 (관련 없음).
지금, 나는 그러나, 그것은 일을하고 나에게 "개체를 제공하지 않습니다, 당신은 경우"바탕 화면 "이렇게 내 시도에서 볼 수있는 골의 H.에서 가능한 선택을 할 무엇을 지정해야합니다 필수 "오류입니다.
기존 코드 :
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Columns(1)) Is Nothing Then
If Target.Value <> "" And InStr(1, Target.Value, ",") Then
Select Case Split(Target.Value, ",")(0)
Case "Desktop": Range("H" & Target.row).Value =
Data.Range("List_Desktops").Address
Case "Laptop": Range("H" & Target.row).Value = "Laptop"
Case "Server": Range("H" & Target.row).Value = "Server"
Case Else: Range("H" & Target.row).Value = "N/A"
End Select
End If
ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then
If Not Target.HasFormula Then Target.Value = UCase(Target.Value)
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
새로운 코드 :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, LastRow As Long, n As Long
Dim MyCol As Collection
Dim SearchString As String, TempList As String
On Error GoTo Whoa
Application.EnableEvents = False
'~~> Find LastRow in List_Descriptions
LastRow = Sheet2.Range("A" & Rows.Count).End(xlUp).row
If Not Intersect(Target, Columns(1)) Is Nothing Then
Set MyCol = New Collection
'~~> Get the data from List_Descriptions into a collection
For i = 1 To LastRow
If Len(Trim(Sheet2.Range("A" & i).Value)) <> 0 Then
On Error Resume Next
MyCol.Add CStr(Sheet2.Range("A" & i).Value), CStr(Sheet2.Range("A" & i).Value)
On Error GoTo 0
End If
Next i
'~~> Create a list for the DV List
For n = 1 To MyCol.Count
TempList = TempList & "," & MyCol(n)
Next
TempList = Mid(TempList, 2)
Range("A" & Target.row).ClearContents: Range("A" & Target.row).Validation.Delete
'~~> Create the DV List
If Len(Trim(TempList)) <> 0 Then
With Range("A" & Target.row).Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=TempList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
'~~> Capturing change in cell D1
ElseIf Not Intersect(Target, Range("A" & Target.row)) Is Nothing Then
SearchString = Range("A" & Target.row).Value
TempList = FindRange(Sheet2.Range("A1:A" & LastRow), SearchString)
Range("H" & Target.row).ClearContents: Range("H" & Target.row).Validation.Delete
If Len(Trim(TempList)) <> 0 Then
'~~> Create the DV List
With Range("H" & Target.row).Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=TempList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
End If
If Target.Value <> "" And InStr(1, Target.Value, ",") Then
Select Case Split(Target.Value, ",")(0)
Case "Desktop": Range("H" & Target.row).Value = "Desktop"
Case "Laptop": Range("H" & Target.row).Value = "Laptop"
Case "Server": Range("H" & Target.row).Value = "Server"
Case Else: Range("H" & Target.row).Value = "N/A"
End Select
End If
ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then
If Not Target.HasFormula Then Target.Value = UCase(Target.Value)
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
'~~> Function required to find the list from Col B
Function FindRange(FirstRange As Range, StrSearch As String) As String
Dim aCell As Range, bCell As Range, oRange As Range
Dim ExitLoop As Boolean
Dim strTemp As String
Set aCell = FirstRange.Find(what:=StrSearch, LookIn:=xlValues, _
lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
ExitLoop = False
If Not aCell Is Nothing Then
Set bCell = aCell
strTemp = strTemp & "," & aCell.Offset(, 1).Value
Do While ExitLoop = False
Set aCell = FirstRange.FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
strTemp = strTemp & "," & aCell.Offset(, 1).Value
Else
ExitLoop = True
End If
Loop
FindRange = Mid(strTemp, 2)
End If
End Function
예제 통합 문서 : https://docs.google.com/open?id=0B9ss2136xoWIVGxQYUJJX2xXc00
당신은 "H"열에서 검증을 삭제하고이 링크 http 같이 다시 작성해야합니다. wordpress.com/2011/07/29/excel-data-validationcreate-dynamic-dependent-lists-vba/ –
그렇게 지나치게 복잡하게 보입니다. –
아마도 지나치게 복잡해 보이지만 그렇지 않습니다. 숨겨진 명명 된 범위가있는 샘플 워크 북을 볼 수 있습니까? –