使用条件自动填充单元格

Posted 2023-02-24

【中文标题】使用条件自动填充单元格

【英文标题】：Autofill cells with condition

【发布时间】：2011-03-25 14:01:32

【问题描述】：

我被代码卡住了。我承认我不是专业的程序员，但尽管我已经花了很多时间在互联网上搜索，但我无法构建代码。情况是这样的。

我有 SheetB 2 列（A 和 C）。在 A 列中，我有一堆 ID 号，并且总是有更多行具有相同的数字（例如：ID 12345 在第 6 到 15 行）。对于每个 ID 号，C 列中都有对应的日期。

在 SheetA 中，在单元格 C4 中，我选择 ID 号，我想创建代码，从第 12 行开始自动填充列 F (sheetA)，其中所有可用日期与 SheetB 中的 ID 匹配。

有人可以帮帮我吗？谢谢！

【参考方案1】：

尝试在您的 Sheet1 代码中使用此代码...如有不清楚之处，请随时询问。

编辑：稍微改变了清理程序。

Private Sub Worksheet_Change(ByVal Target As Range)

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

结束子

编辑：

更新了清理代码。检查它是否符合您的期望。

【讨论】：

你明白了！感谢您的帮助。

看来我有一个错误“1004”。调试显示此 oRangeResult.Clear。我会努力解决这个问题

嗨，我已经更改了清理程序。我相信我们不会再有错误 1004 了。此外，还添加了一些 cmets 以方便代码的理解。

你好。代码看起来不错，但它没有这样做。目标工作表中的值不会出现。这很奇怪。

在代码行中添加断点 oCellResult.Offset(iCellCount, 0).Value = oCell.Offset(0, 2).Value 并检查是否在代码停止时在断点处，值位于语句的右侧（即在 Cell.Offset(0, 2).Value 中）。要查看此代码的值，只需将光标移到此代码上即可。

【参考方案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