Datenbereich ersetzen, wenn Zielwert bereits vorhanden ist

Question

Das folgende Skript wählt einen Datenbereich auf einem Blatt aus und übergibt die Auswahl an ein anderes Blatt. wenn der Wert in Spalte A

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 

Ich würde jetzt ein Skript vorstellen mag, die die Reihe von Daten auf dem Zielblatt ersetzen werden bereits vorhanden ist, aber ich bin nicht sicher, wie dies zu erreichen, jede Hilfe ist viel geschätzt.

Vielen Dank im Voraus.

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

Ich schlage vor, eine Dictionary -Objekt verwendet, die am wahrscheinlichsten ist ein Hash-Map. Der Vorteil ist, dass Sie mit der eingebauten Methode Dictionary.Exists(Key) prüfen können, ob das Dictionary bereits den angegebenen Wert (Key) enthält.

Auch sollten Sie die Arbeitsmappe nicht in jedem Schritt der Iteration speichern. Es wäre besser (und schneller), die Arbeitsmappe erst zu speichern, nachdem Sie Ihre gesamten Daten kopiert haben.

Außerdem sind Ihre If -Tests nach dem Kopieren und Einfügen nicht notwendig, da Sie bereits vor dem Kopieren nach Cells(i,1)<>"" suchen, so dass Sie dies nicht erneut überprüfen müssen, da es sich nicht ändert.

Der folgende Code zeigt, wie Sie Ihr gewünschtes Ergebnis erhalten:

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