Question

我创建了一个excel电子表格，它将跟踪从我们的外部代理发回的错误资产，我有两个选项卡，它们将成为此电子表格的主要关注点。选项卡1将是测试的资产选项卡，选项卡2将等待测试。因此，一旦发回的任何资产将被手动登录在等待测试选项卡上，但是一旦经过测试，我就创建了一个vba代码，该代码将导出任何标有“Y”的内容，这意味着它已经过测试。资产标签。

但我遇到的问题是，一个资产可以进入测试并不止一次被送回现场给我们的工程师，所以如果它又回来再次测试并登录等待测试和一旦它经过测试并导出到测试资产选项卡，它就会复制已测试资产选项卡上的内容，并获得两个具有相同数据的单元格。无论如何，我可以放入另一行代码，它会在导出之前提示我复制。见下面的代码;

Sub automove()

Dim SerialNo As String
Dim AwaitTestLastRow, PasteToRow As Long

Sheets("Awaiting Testing").Select

AwaitTestLastRow = Range("a1000000").End(xlUp).Row

For x = AwaitTestLastRow To 3 Step -1

    If Range("c" & x).Value = "Y" Or Range("c" & x).Value = "y" Then

        SerialNo = Range("a" & x).Value
        Rows(x).Delete

        Sheets("Tested Assets").Select

        Range("a1000000").End(xlUp).Offset(1, 0).Value = SerialNo
        Range("e1000000").End(xlUp).Offset(1, 0).Value = SerialNo

        PasteToRow = Range("a1000000").End(xlUp).Row

        Range("b3:d3").Select
        Selection.Copy
        Range("b" & PasteToRow & ":d" & PasteToRow).Select

        ActiveSheet.Paste

        Range("f3").Select
        Selection.Copy
        Range("f" & PasteToRow & ":f" & PasteToRow).Select

        ActiveSheet.Paste

        Sheets("Awaiting Testing").Select

    End If

Next x

Answer 1

有许多不同的方法可以检查重复项。在下面的代码中，我在“Tested Assets”工作表上使用了.Find函数。如果返回对象是Nothing，那么它是一个新项目，如果它是Range，那么我们就知道你的副本的地址。它不一定是最快的方式（例如，Collection可能更快），但.Find功能仍然非常活泼，因为，您将在我的下一条评论中看到，我希望得到范围地址。

我在下面添加了一些代码，而不是提示您输入重复内容，记录相同项目返回测试实验室的频率 - 对于跟踪重复违规者可能会有一些用处。但是，如果您不想这样，则删除4行并替换为MsgBox asset(1, 1) & " is a duplicate."

我稍微调整了你的代码以加快它的速度，并注意在同一行声明两个变量，因为每个变量必须有自己的声明类型。在你的行Dim AwaitTestLastRow, PasteToRow As Long中，AwaitTestLastRow变量不是Long（实际上没有输入，即Variant）。

Sub AutoMove_v2()
    Dim awaitingRange As Range
    Dim testedRange As Range
    Dim flaggedRange As Range
    Dim newRow As Range
    Dim dupCell As Range
    Dim testFlag As String
    Dim asset As Variant
    Dim cell As Range
    Dim frq As Long

    'Initialise the parameters
    With ThisWorkbook.Worksheets("Awaiting Testing")
        Set awaitingRange = .Range("A3", _
                            .Cells(.Rows.Count, "A").End(xlUp))
    End With
    With ThisWorkbook.Worksheets("Tested Assets")
        Set testedRange = .Range("A1", _
                            .Cells(.Rows.Count, "A").End(xlUp))
    End With

    'Loop through the awaiting sheet to find assets for transferral
    For Each cell In awaitingRange
        testFlag = UCase(cell.Offset(, 2).value)
        If testFlag = "Y" Then
            If flaggedRange Is Nothing Then
                Set flaggedRange = cell
            Else
                Set flaggedRange = Union(flaggedRange, cell)
            End If
        End If
    Next

    'Identify duplicates or transfer new assets
    For Each cell In flaggedRange
        asset = cell.Resize(, 4).value
        Set dupCell = testedRange.Cells.Find(What:=asset(1, 1), _
                                             After:=testedRange.Cells(1), _
                                             LookIn:=xlFormulas, _
                                             LookAt:=xlWhole, _
                                             SearchOrder:=xlByRows, _
                                             SearchDirection:=xlNext, _
                                             MatchCase:=True)

        If dupCell Is Nothing Then
            'It's a new entry so transfer the values
            Set newRow = testedRange.Cells(testedRange.Cells.Count).Offset(1)
            Set testedRange = Union(testedRange, newRow)
            newRow.Resize(, 4) = asset
        Else
            'It's a duplicate so increment the frequency counter
            frq = dupCell.Offset(, 5).value
            If frq = 0 Then frq = 1
            frq = frq + 1
            dupCell.Offset(, 5) = frq
        End If
    Next

    'Delete the transferred rows
    flaggedRange.EntireRow.Delete
End Sub

如何防止重复创建

1 个答案: