자동 채우기 세포 - VBA

Question

목표

나는 세 가지 시트 (내가 하나를 시작 해요)을 순환에 좋아 채우는 자동으로 열 C의 특정 유형을 찾아서 것/열 D의 In-cell 드롭 다운 (데이터 유효성 검사 설정에서 발견 된 것과 유사)을 자동 채우기. In-cell 드롭 다운에는 모든 유형의 값이 나열되어야하지만 유형에 속한 값으로 자동 채취해야합니다.

문제 코드는 아래와 같은 값으로 모든 셀 내 드롭 다운 목록을 채워

즉 타입 1의 항목 1 - 항목 2 - 항목 3 - Item4.

모든 값을 나열하는 동시에 셀을 자동 채우는 방법을 모르겠습니다.

간단하게하기 위해서

코드

원하는 출력, 난 단지 아래의 코드에서 처음 두 유형을 추가했습니다.

Sub AutoDropdown() 

Dim PersonSource As Range 
Dim PersonSourceTotal As Range 
Dim PersonCell As Range 
'Dim ws As Worksheet 

Dim i As Integer 
Dim lastRow As Integer 

Set PersonSourceTotal = Sheets("Sheet1").Range("D2:D200") 

With PersonSourceTotal.Offset(0, -2) 
    lastRow = .Cells(.Rows.Count, PersonSourceTotal.Columns.Count).End(xlUp).Row 
End With 

Set PersonSource = Sheets("sheet1").Range("D2:D" & lastRow) 

On Error Resume Next 

For Each PersonCell In PersonSource 
    Name = PersonCell.Offset(0, -3) 
    ID = PersonCell.Offset(0, -2) 
     If Name <> "" And ID <> "" Then 
      For i = 0 To lastRow 
       If PersonCell.Offset(i, -1) = "Type1" Then 
        arr1 = Array("Item1", "Item2", "Item3", "Item4") 
        arr1Merged = Join(arr1, "--") 
        With PersonCell.Validation 
               .Delete 
               .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
               Operator:=xlBetween, Formula1:=arr1Merged 
               .IgnoreBlank = True 
               .InCellDropdown = True 
               .InputTitle = "" 
               .ErrorTitle = "" 
               .InputMessage = "" 
               .ErrorMessage = "" 
               .ShowInput = True 
               .ShowError = True 
        End With 
       ElseIf PersonCell.Offset(i, -1) = "Type2" Then 
        arr2 = Array("Item5", "Item6", "Item7", "Item8", "Item9") 
        arr2Merged = Join(arr2, "--") 
        Debug.Print (arr2Merged) 
        With PersonCell.Validation 
               .Delete 
               .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
               Operator:=xlBetween, Formula1:=arr2Merged 
               .IgnoreBlank = True 
               .InCellDropdown = True 
               .InputTitle = "" 
               .ErrorTitle = "" 
               .InputMessage = "" 
               .ErrorMessage = "" 
               .ShowInput = True 
               .ShowError = True 
        End With 
       End If 
      Next i 
     Else 
      MsgBox "Remember to add Name and ID" 
     End If 
Next PersonCell 
End Sub 

Answer 1

편집 :

더 나은 귀하의 요구 사항 반영하려고 코드를 업데이트 한 귀하의 의견 후 :

이

Sub AutoDropdown() 
Dim PersonSource As Range 
Dim PersonSourceTotal As Range 
Dim PersonCell As Range 
Dim i As Long 
Dim lastRow As Long 
Dim SelectionArray(1 To 4) As String 

Set PersonSourceTotal = Sheets("Sheet1").Range("D2:D200") 

With PersonSourceTotal.Offset(0, -2) 
    lastRow = .Cells(.Rows.Count, PersonSourceTotal.Columns.Count).End(xlUp).Row 
End With 

Set PersonSource = Sheets("Sheet1").Range("D2:D" & lastRow) 

arr1 = Array("Item1", "Item2", "Item3", "Item4") 'Define your selections items 
arr2 = Array("Item5", "Item6", "Item7", "Item8", "Item9") 
arr3 = Array("ItemE", "ItemF", "ItemG", "ItemH") 
arr4 = Array("ItemA", "ItemB", "ItemC", "ItemD") 

SelectionArray(1) = Join(arr1, "--") 'join the selections into another array 
SelectionArray(2) = Join(arr2, "--") 
SelectionArray(3) = Join(arr3, "--") 
SelectionArray(4) = Join(arr4, "--") 
AllSelections = Join(SelectionArray, ",") 'group all selections for data validation 
On Error Resume Next 

For Each PersonCell In PersonSource 
    VarName = PersonCell.Offset(0, -3) 
    ID = PersonCell.Offset(0, -2) 
     If VarName <> "" And ID <> "" Then 
      Select Case PersonCell.Offset(i, -1).Value 
       Case "Type1" 
        With PersonCell.Validation 
         .Delete 
         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AllSelections 
        End With 
        PersonCell.Value = SelectionArray(1) 
       Case "Type2" 
        With PersonCell.Validation 
         .Delete 
         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AllSelections 
        End With 
        PersonCell.Value = SelectionArray(2) 
       Case "Type3" 
        With PersonCell.Validation 
         .Delete 
         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AllSelections 
        End With 
        PersonCell.Value = SelectionArray(3) 
       Case "Type4" 
       With PersonCell.Validation 
         .Delete 
         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AllSelections 
        End With 
        PersonCell.Value = SelectionArray(4) 
       Case Else 
        MsgBox "No Type was entered on Column C" 
      End Select 
     Else 
      MsgBox "Remember to add VarName and ID" 
     End If 
Next PersonCell 
End Sub 

UPDATE :

을 얻으려면을 열 C의 값 (즉, 유형 번호)이 변경되면 자동으로 실행되는 코드 Sheet1 아래에 다음 코드를 추가해야합니다 :

Private Sub Worksheet_Change(ByVal Target As Range) 
If Target.Column = 3 Then AutoDropdown 'if a value is changed on Column 3/ Column C then call the name of the above subroutine, in this case it is called AutoDropdown 
End Sub