excel - Range.Find 根据条件返回正确的值

Question

我正在尝试将任务从一张表（WS）导入到主跟踪表（子任务）。导入表具有里程碑，然后是每个里程碑中的子任务。

我的代码导入里程碑然后返回并导入每个里程碑的子任务。但是，如果正在添加的里程碑与子任务表中已有的具有相同的标题，它会将子任务添加到不正确的里程碑。我正在使用 Range.Find，我知道它会找到第一个匹配项，这不是我一直想要的。所以我想在其中添加条件，所以如果找到匹配项，并且 H 列中的值等于工作表中 N9 中的值，然后子任务列 I 中的值等于 N10 中的值WS，然后添加。

如果没有，找到next并再次测试。但是，我似乎无法让它工作。

更新

                If .Cells(findactivityintasks.row, TDSNumCol).Value = ImportWs.Range("N9").Value And .Cells(findactivityintasks.row, MileStoneNumCol).Value = DeliverableActivity Then
                    newdeliverablerow = (findactivityintasks.row)
                Else
                    Do
                        Set findactivityintasks = .Range("B3:B" & lastrowsubtasks1).FindNext(findactivityintasks)
                    Loop Until .Cells(findactivityintasks.row, TDSNumCol).Value = ImportWs.Range("N9").Value And .Cells(findactivityintasks.row, MileStoneNumCol).Value = DeliverableActivity
                    newdeliverablerow = (findactivityintasks.row)
                End If

SUB 的所有代码

'Add Milestone to subtask sheets
For Each cell In ImportWs.Range("B" & activityStart & ":B" & activityend)
NewRowSubTasks = lastrowsubtasks + i
DeliverableActivity = Int(cell.Offset(0, -1).Value)
    With subtaskws
        .Range(SubTaskCol & NewRowSubTasks & ":" & lastcollet & NewRowSubTasks).Interior.ColorIndex = 16
        .Range(SubTaskCol & NewRowSubTasks & ":" & lastcollet & NewRowSubTasks).Font.ColorIndex = 2
        .Range(SubTaskCol & NewRowSubTasks & ":" & lastcollet & NewRowSubTasks).Font.Size = 12
        .Range(IDCol & NewRowSubTasks).Interior.ColorIndex = 23
        .Range(IDCol & NewRowSubTasks).Font.ColorIndex = 2
        .Range(IDCol & NewRowSubTasks).Font.Size = 16
        .Range(IDCol & NewRowSubTasks).NumberFormat = "0"
        .Cells(NewRowSubTasks, SubTaskCol).Value = ImportWs.Range("B" & cell.row).Value
        .Cells(NewRowSubTasks, IDCol).Value = Application.WorksheetFunction.RoundUp((subtaskws.Range("A" & NewRowSubTasks - 1).Value + 0.01), 0)
        .Cells(NewRowSubTasks, TDSNumCol).Value = ImportWs.Range("N9").Value
        .Cells(NewRowSubTasks, MileStoneNumCol).Value = DeliverableActivity
        .Cells(NewRowSubTasks, BWLCol).Value = ImportWs.Range("L" & cell.row).Value
    End With
    i = i + 1
Next cell

'find start and end of deliverables
DeliverableStart = valuePos(ImportWs, "C:G", "Outputs / Deliverables") + 1
DeliverableEnd = valuePos(ImportWs, "A:G", "Tools / constraints") - 1


'find deliverables to add to Milestones and find what Milestones to add them too
For Each cell In ImportWs.Range("C" & DeliverableStart & ":C" & DeliverableEnd)
    DeliverableActivity = Int(cell.Offset(0, -1).Value)
    Set finddeliverableactivity = ImportWs.Range("A" & activityStart & ":A" & activityend).Find(What:=("# " & (DeliverableActivity + 1)), Lookat:=xlWhole)
        If finddeliverableactivity Is Nothing Then
            With subtaskws
                Dim lastrowsubtasks1 As Long
                lastrowsubtasks1 = subtaskws.Range("A" & Rows.Count).End(xlUp).row
                newdeliverablerow = (lastrowsubtasks1 + 1)
                .Range("A" & (newdeliverablerow)).EntireRow.Insert
                newrow = newdeliverablerow
                .Range("A4").EntireRow.Copy
                .Range("A" & newrow).EntireRow.PasteSpecial xlPasteFormulasAndNumberFormats
                .Range("A" & newrow).EntireRow.PasteSpecial xlPasteValidation
                .Range("A" & newrow).EntireRow.PasteSpecial xlPasteAllMergingConditionalFormats
                .Range("A" & newrow & ":AE" & newrow & "").ClearContents
                .Columns("A:BB").Calculate
                .Range(IDCol & newrow).Value = subtaskws.Range("A" & newrow).Offset(-1, 0).Value + 0.01
                .Cells(newrow, SubTaskCol).Value = cell.Value
                .Cells(newrow, FormatCol).Value = cell.Offset(0, 1).Value
                .Cells(newrow, AcceptanceCriteriacol).Value = cell.Offset(0, 2).Value
                .Cells(newrow, TargetDateCol).Value = cell.Offset(0, 9).Value
                .Cells(newrow, BWLCol).Value = cell.Offset(0, 7).Value
                .Cells(newrow, TDSNumCol).Value = ImportWs.Range("N9").Value
                .Cells(newrow, MileStoneNumCol).Value = DeliverableActivity
                .Cells(newrow, AWCol).Value = "=SUM(AF" & newrow & ":" & lastcollet & newrow & ")"
                .Cells(newrow, PCol).Value = "=(" & WCol & newrow & "*" & ICol & newrow & "*" & ECol & newrow & ")"
                .Cells(newrow, LevelCol).Value = "=IF(" & PCol & newrow & " >11,1,IF(" & PCol & newrow & ">3,2,""N/A""))"
                .Range("A" & newrow).EntireRow.Hidden = False
            End With
            Exit Sub
        Else
            With subtaskws
                lastrowsubtasks1 = subtaskws.Range("A" & Rows.Count).End(xlUp).row
                activityrow = finddeliverableactivity.row
                ActivtiyforDeliverable = ImportWs.Range("B" & activityrow).Value
                Set findactivityintasks = .Range("B3:B" & lastrowsubtasks1).Find(What:=(ActivtiyforDeliverable), Lookat:=xlWhole)
                newdeliverablerow = (findactivityintasks.row)
                .Range("A" & (newdeliverablerow)).EntireRow.Insert
                newrow = newdeliverablerow
                .Range("A4").EntireRow.Copy
                .Range("A" & newrow).EntireRow.PasteSpecial xlPasteFormulasAndNumberFormats
                .Range("A" & newrow).EntireRow.PasteSpecial xlPasteValidation
                .Range("A" & newrow).EntireRow.PasteSpecial xlPasteAllMergingConditionalFormats
                .Range("A" & newrow & ":AE" & newrow & "").ClearContents
                .Columns("A:BB").Calculate
                .Range(IDCol & newrow).Value = subtaskws.Range("A" & newrow).Offset(-1, 0).Value + 0.01
                .Cells(newrow, SubTaskCol).Value = cell.Value
                .Cells(newrow, FormatCol).Value = cell.Offset(0, 1).Value
                .Cells(newrow, AcceptanceCriteriacol).Value = cell.Offset(0, 2).Value
                .Cells(newrow, TargetDateCol).Value = cell.Offset(0, 9).Value
                .Cells(newrow, BWLCol).Value = cell.Offset(0, 7).Value
                .Cells(newrow, TDSNumCol).Value = ImportWs.Range("N9").Value
                .Cells(newrow, MileStoneNumCol).Value = DeliverableActivity
                .Cells(newrow, AWCol).Value = "=SUM(AF" & newrow & ":" & lastcollet & newrow & ")"
                .Cells(newrow, PCol).Value = "=(" & WCol & newrow & "*" & ICol & newrow & "*" & ECol & newrow & ")"
                .Cells(newrow, LevelCol).Value = "=IF(" & PCol & newrow & " >11,1,IF(" & PCol & newrow & ">3,2,""N/A""))"
                .Range("A" & newrow).EntireRow.Hidden = False
            End With
        End If

Next cell

Call CompactView

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

标签： excelvba