使用條件自動填充單元格

Question

我被代碼卡住了。我承認我不是一位專家程序員，但儘管已經花了很多時間在互聯網上搜索，但我無法構建代碼。情況是這樣的。

我有SheetB 2列（A和C）。在A列中，我有一堆ID號碼，並且總是有更多的行具有相同的號碼（例如：ID 12345在第6行至第15行）。對於每個ID號，C列中都有對應的日期。

在SheetA中的單元格C4中，選擇ID號，我想創建自動填充行F（sheetA）的代碼，從第12行開始，可用日期與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