如果目標值已存在，則更換數據範圍

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 -object這是最有可能是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