シート上の値とワークシート全体との比較

Question

複数の編集後で：

私はいくつかのシートが4〜8枚あるExcelシートを持っています。これは以前のレポートの情報です。そして、私はナイキのシートを持っています。すべての最新値が入っています。その中には現在のアイテムと新しいアイテムがあります。ナイキの行を読んで、4〜8のシートに新しい行があるかどうか調べています。

悲しいことに、私はコードが部分的に正常に機能しています。つまり、コードが読み込まれ、必要な行の一部をコピーできます。

このコードは、ブックの残りの部分に向けてNIKEから追加された行を読んで、存在しない場合は、それらを追加し、その後、私はトラッカーシートにコピーします（現時点で追加されます

Sub CompareNew() 
Dim cellName, cellCl As Range 
Dim uF, uFS As Long 
Dim sName, ClName As String 
Dim sDevice, sImported, sTracker As Worksheet 

Application.ScreenUpdating = False 

Set sImported = Sheets("NIKE-DOC-REP-DEVICE_SERVICETOCI") 
uF = sImported.Range("A" & Rows.Count).End(xlUp).Row 
Set sTracker = Sheets("Tracking Add-Delete") 'Hoja de tracking 
uFT = sTracker.Range("B" & Rows.Count).End(xlUp).Row 

For Each cellName In sImported.Range("A2:A" & uF) 
sName = cellName 
ClName = cellName.Offset(, 3) 

Set sDevice = Worksheets(sName) 
uFS = sDevice.Range("B" & Rows.Count).End(xlUp).Row 

Set cl = sDevice.Range("E5:E" & uFS).Find(ClName, , , lookat:=xlWhole) 
    If cl Is Nothing Then 
     sDevice.Cells(uFS + 1, 2) = sDevice.Cells(uFS, 2) + 1 
     sImported.Activate 
     sImported.Range(Cells(cellName.Row, 2), Cells(cellName.Row, 10)).Copy sDevice.Cells(uFS + 1, 3) 
     sTracker.Cells(uFT + 1, 2) = Format(Date, "[$-en-US]mmmm d, yyyy;@)") 'El codigo ya empieza a copiar informacion a la hoja de Tracking 
     sImported.Cells(cellName.Row, 4).Copy sTracker.Cells(uFT + 1, 3) 
     sImported.Cells(cellName.Row, 2).Copy sTracker.Cells(uFT + 1, 4) 
     sImported.Cells(cellName.Row, 3).Copy sTracker.Cells(uFT + 1, 5) 
     sTracker.Cells(uFT + 1, 6) = "Added" 
    Else 
    End If 
Next cellName 

Application.ScreenUpdating = True 

End Sub 

下のコードを参照してください。それぞれのシートにすべてが、トラッカーシートにすべてをcopying'emない）

以下は反対のコード..です

Sub CompareOld() 
Dim cellName, cellCl As Range 
Dim uF, uFS As Long 
Dim sName, ClName As String 
Dim sDevice, sImported, sTracker As Worksheet 

Application.ScreenUpdating = False 

wsName = Array("WAN Backbone-DC-RoutersSwitches", "Tools Servers", "Backbone Firewall", "Voice Messaging Managed Device", "NGWAN devices") 

For i = 0 To UBound(wsName) 
    Set sDevice = Worksheets(wsName(i)) 
    uFS = sDevice.Range("B" & Rows.Count).End(xlUp).Row 
    Set sImported = Sheets("NIKE-DOC-REP-DEVICE_SERVICETOCI") 
    uF = sImported.Range("A" & Rows.Count).End(xlUp).Row 
    Set sTracker = Sheets("Tracking Add-Delete") 
    uFT = sTracker.Range("B" & Rows.Count).End(xlUp).Row 

    For Each cellName In sDevice.Range("E5:E" & uFS) 
     ClName = cellName 

     Set cl = sImported.Range("E5:E" & uFS).Find(ClName, , , lookat:=xlWhole) 
     If cl Is Nothing Then 
      sTracker.Activate 
      sTracker.Cells(uFT + 1, 2) = Format(Date, "[$-en-US]mmmm d, yyyy;@)") 
      sDevice.Cells(cellName.Row, 5).Copy sTracker.Cells(uFT + 1, 3) 
      sDevice.Cells(cellName.Row, 3).Copy sTracker.Cells(uFT + 1, 4) 
      sDevice.Cells(cellName.Row, 4).Copy sTracker.Cells(uFT + 1, 5) 
      sTracker.Cells(uFT + 1, 6) = "Removed" 
      sDevice.Rows(cellName.Row).EntireRow.Delete 
     End If 
    Next cellName 
Next i 

Application.ScreenUpdating = True 

End Sub 

この1つの意志D現在の行を比較し、NIKEシートに存在しない行があれば、現在のシートから削除してトラッカーシートにコピーします。 （これはまったくうまくいきません...なぜなら！）

ファイルが添付されています。このファイルが含まれているVBAモジュール2を参照してください。任意のヒントを事前に

ファイル 以下https://drive.google.com/file/d/10rXA6fInX5g8zJucrnxsNHl-7vXBpIvz/view?usp=sharing

ありがとう！そして、いつものように、トラブルのため申し訳ありません...

Answer 1

の代わりに：

Set lookIn = Sheets(strName).Range("E5:B" & Range("E" & Rows.Count).End(xlUp).Row) 

...あなたは...

Set lookIn = Sheets(strName).Range*"E5:B" & !Sheets(strName).UsedRange.Rows.Count - x 

を試みることができる... xはの数であります下から行をスキップします。それが問題の唯一のものなら、少なくとも最後のシートについては良いアイデアかもしれません。

（あなたは見た目それを微調整する必要がある場合がありますので、私はあなたのデータについては何も知らないので、このコードは、テストされていません。）

一部の人々はUsedRangeはループスルーに良い方法ではないことを教えてくれますこれは、セルにデータを入れた後、そのセルからデータを消去すると、それはまだ「使用済み」とみなされるからです。

しかし、私はそれに問題は一度もなく、いくつかの選択肢よりも速いです。