2017-03-20 1 views
0

Ich habe 8 Blätter mit mehreren Spalten Daten, ich möchte diese 7 Blätter vlookup mit sheet8 und was auch immer die ids sind da in sheet8 sollte in allen 7 Blatt verbleibenden Zeile vorhanden sein sollte gelöscht werden.Vlookup Mehrere Blätter mit Referenz

Der Code ist unter dem, was ich habe, aber es arbeitet nicht immer noch ich kann einige ID mit # N/A in den Daten vorhanden sehen.

Sub delete() 

    Dim arr(), msg As String 
    Dim c As Range 
    Dim ws_lrow, ws8_lrow, i As Integer 
    Dim ws As Worksheet 

    ws8_lrow = Sheets("Sheet8").Cells(Rows.Count, 1).End(xlUp).Row 

    ReDim arr(ws8_lrow) 

    For i = 2 To ws8_lrow 
     arr(i - 2) = Sheets("Sheet8").Cells(i, 1).Value 
    Next i 

    For Each ws In ActiveWorkbook.Sheets 
     ws_lrow = ws.Cells(Rows.Count, 2).End(xlUp).Row 

     For Each c In ws.Range("B2:B" & ws_lrow) 
      If IsInArray(c, arr()) = 0 Then 
       msg = msg & "User '" & c & "' from: " & ws.Name & vbCrLf 
       c.EntireRow.delete xlShiftUp 
      End If 
     Next c 
    Next ws 

    MsgBox "The following users have been deleted:" & vbCrLf & msg 

End Sub 

Private Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean 

    Dim element As Variant 
    On Error GoTo IsInArrayError: 'array is empty 
     For Each element In arr 
      If element = valToBeFound Then 
       IsInArray = True 
       Exit Function 
      End If 
     Next element 
    Exit Function 

IsInArrayError: 
    On Error GoTo 0 
    IsInArray = False 

End Function 

Antwort

1

Du comitting einen klassischen Fehler, wenn über einen Bereich von Zeilen, von oben nach unten laufen, und Löschen von Zeilen während des gesamten Prozesses. In dieser Art von Situation ist der einfachste und korrekte Weg, von unten nach oben zu loopen. Diese Schleife sollte festgelegt werden:

'For Each c In ws.Range("B2:B" & ws_lrow) 
' If IsInArray(c, arr()) = 0 Then 
'  msg = msg & "User '" & c & "' from: " & ws.Name & vbCrLf 
'  c.EntireRow.delete 
' End If 
'Next c 

Schleife von unten wie folgt auf:

For i = ws_lrow to 2 step -1 
    If IsInArray(ws.Range("B" & i).value, arr) = 0 Then 
     msg = msg & "User '" & ws.Range("B" & i).value & "' from: " & ws.Name & vbCrLf 
     ws.Rows(i).delete 
    End If 
Next i