조건이있는 셀 자동 채우기

Question

코드가 붙어 있습니다. 필자는 전문가 프로그래머가 아니라고 인정하지만, 인터넷에서 검색하는 데 많은 시간을 소비 했음에도 불구하고 코드를 작성할 수는 없습니다. 상황이 이것입니다.

저는 SheetB 2 열 (A 및 C)을 사용했습니다. A 열에는 ID 번호가 있으며 동일한 번호의 행이 항상 있습니다 (예 : ID 12345는 행 6에서 15까지입니다). 각 ID 번호에는 해당 열의 날짜가 C 열에 있습니다.

SheetA에서 셀 C4에서 ID 번호를 선택하고 열 12에서 시작하는 열 F (sheetA)를 자동으로 채우는 코드를 만들고 싶습니다. SheetB에서 ID와 일치하는 사용 가능한 날짜.

누군가 나를 도와 줄 수 있습니까? 감사!

Answer 1

Sheet1 코드에서이 코드를 사용해보십시오. 명확하지 않은 것이 있으면 언제든지 물어보십시오.

편집 : 약간 변경된 정리 루틴.

개인 서브 Worksheet_Change (ByVal의 다른 이름으로 대상 범위)

Dim oCell As Excel.Range 
Dim oCellResult As Excel.Range 
Dim oCellClean As Excel.Range 
Dim oRangeID As Excel.Range 
Dim iCellCount As Integer 

If Target.Address = "$C$4" Then 

    'Set source data 
    Set oRangeID = Sheets(2).Range("A:A") 

    'Define initial target for the results obtained 
    Set oCellResult = Sheets(1).Range("F12") 

    'Clear up any previous data 
    'Set oCellClean = oCellResult 
    'While Len(oCellClean.Value) > 0 
    '  
    ' oCellClean.Clear 
    ' Set oCellClean = oCellClean.Offset(1, 0) 
    '  
    'Wend 

    Set oCellClean = Range(oCellResult, oCellResult.End(xlDown)) 
    oCellClean.ClearContents 

    'Scans source range for match data 
    For Each oCell In oRangeID 

     If oCell.Value = "" Then Exit For 

     If oCell.Value = Target.Value Then 

      oCellResult.Offset(iCellCount, 0).Value = oCell.Offset(0, 2).Value 
      iCellCount = iCellCount + 1 

     End If 

    Next oCell 

End If 

최종 하위

편집 : 업데이트

코드를 정리. 그것이 당신의 기대에 맞는 지 확인하십시오.

Answer 2

이 시도 :

Dim rgIDsAndDates As Range: Set rgIDsAndDates = Range("name") 
Dim DATEs As Collection ' to collect date values for a given ID 
Dim IDs As Collection ' to collect all the DATEs collections for all IDs 

' step 1: loop to create (initially empty) collections for each unique ID 
Set IDs = New Collection 
Dim rgRow As Range 
For Each rgRow In rgIDsAndDates.Rows 
    Set DATEs = New Collection 
    On Error Resume Next 
    ' the foll line will save an (empty) DATEs collection keyed by the ID 
    Call IDs.Add(DATEs, CStr(rgRow.Cells(1, 1).Value)) ' col 1 as the ID 
    On Error GoTo 0 
Next rgRow 

' step 2: loop to fill each DATEs collection with the dates for that ID 
For Each rgRow In rgIDsAndDates.Rows 
    ' the foll line retrieves the DATEs for the corresp ID 
    Set DATEs = IDs(CStr(rgRow.Cells(1, 1).Value)) ' col 1 has the ID 
    Call DATEs.Add(rgRow.Cells(1, 3).Value)  ' store the date from col 3 
Next rgRow 

' for testing ... list the dates for ID "123" 
Set DATEs = IDs("123") 
Dim dt As Variant 
For Each dt In DATEs 
    Debug.Print "date: " & dt 
    ' put that dt where you want 
Next dt