Question

以下脚本在一张纸上选择一系列数据，并将选择内容传送到另一张纸。

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To LastRow

    If Cells(i, 1) <> "" And Cells(i, 21) = "OK" And Cells(i, 22) <> "Yes" Then
        Range(Cells(i, 1), Cells(i, 4)).Select
        Selection.Copy

        erow = Worksheets("iForms").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        Worksheets("iForms").Cells(erow, 1).PasteSpecial Paste:=xlPasteValues

        If Cells(i, 1) <> "" Then Cells(i, 22).Value = "Yes"
        If Cells(i, 22) <> "" Then Cells(i, 23).Value = Now
        If Cells(i, 23) <> "" Then Cells(i, 24).Value = Environ("UserName")
        ActiveWorkbook.Save

    End If
Next i

我现在想介绍一个脚本，如果A列中的值已经存在，它将替换目标表上的数据行，但我不知道如何实现这一点，我们非常感谢任何帮助。

提前谢谢。

Answer 1

Public Function IsIn(li, Val) As Boolean
    IsIn = False
    Dim c
    For Each c In li
        If c = Val Then
            IsIn = True
            Exit Function
        End If
    Next c
End Function

dim a: a= range(destWB.sheet(whatever)..range("A1"),destWB.Range("A" & destWB.sheet(whatever).Rows.Count).End(xlUp)).value
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To LastRow
    if isin(a, Cells(i, 1) ) then
    do whatever you want
    else
    If Cells(i, 1) <> "" And Cells(i, 21) = "OK" And Cells(i, 22) <> "Yes" Then
        Range(Cells(i, 1), Cells(i, 4)).Select
        Selection.Copy

        erow = Worksheets("iForms").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        Worksheets("iForms").Cells(erow, 1).PasteSpecial Paste:=xlPasteValues

        If Cells(i, 1) <> "" Then Cells(i, 22).Value = "Yes"
        If Cells(i, 22) <> "" Then Cells(i, 23).Value = Now
        If Cells(i, 23) <> "" Then Cells(i, 24).Value = Environ("UserName")
        ActiveWorkbook.save
    End If    
    End If
Next i

Answer 2

我建议使用Dictionary - 对象，这很可能是Hash-Map。优点是您可以使用内置方法Dictionary.Exists(Key)来检查Dictionary是否已经包含指定值（Key）。

此外，您不应该在迭代的每个步骤中保存工作簿。完成复制整个数据后，只保存工作簿会更好（也更快）。

此外，您的If - 复制粘贴后的测试不是必需的，因为您在复制前已经检查了Cells(i,1)<>""，因此您不必再次检查，因为它不会更改

以下代码显示了如何获得所需结果：

Set dict = CreateObject("Scripting.Dictionary")
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To LastRow

  If Cells(i, 1) <> "" And Cells(i, 21) = "OK" And Cells(i, 22) <> "Yes" Then

    If dict.Exists(Cells(i,1).Value) Then
    'value already exists -> update row number
      dict.Item(Cells(i,1).Value)=i
    Else
    'save value of column A and row number in dictionary
      dict.Add Cells(i,1).Value, i
    End If

    Cells(i, 22).Value = "Yes"
    Cells(i, 23).Value = Now
    Cells(i, 24).Value = Environ("UserName")

  End If
Next i

'finally copy over your data (only unique values)
For Each i In dict.Items
    Range(Cells(i, 1), Cells(i, 4)).Select
    Selection.Copy

    erow = Worksheets("iForms").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Worksheets("iForms").Cells(erow, 1).PasteSpecial Paste:=xlPasteValues
Next i

如果目标值已存在，则替换数据范围

2 个答案: