2017-03-20 15 views
0

複数の列のデータを持つ8枚のシートがあります。これらの7枚のシートをsheet8で眺めていて、残りの7枚のシートすべてにsheet8のidsが存在する必要があります。Vlookup参照を使用して複数のシート

コードが私の持っているコードの下にありますが、それでも正常に動作していないのは、まだデータに#N/Aがあることがわかります。

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 

答えて

1

あなたは、行の範囲を反復処理するとき、古典ミスをcomittingトップダウン、およびプロセス全体の行を削除します。このタイプの状況では、最も簡単で正しい方法は、をボトムからにループすることです。このループは、固定する必要があります。

'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 

ループこのようなボトムアップから:

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