新しい値のみをコピーする追加条件

Question

次のコードは、シート（SOC 5）の列BHに特定の値を持つデータの行を識別し、行Aの対応する値を各行からコピーして、新しいシートに。 しかし、新しく識別された値だけを宛先シートにコピーするコードを修正する必要があります。意味、目的地のシートはすでに私が探している価値のいくつかを持っていた。基になるデータをリフレッシュした後、基準を満たす最新の値だけを引き出すコードが必要です。

あなたが出会うすべてのデータ移動を試すことができます

Sub Cond5Copy() 
'The data is in sheet Data 
Sheets("Data").Select 
RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row 
For i = 1 To RowCount 
    'the qualifying value is in column BH 
    Range("BH" & i).Select 
    check_value = ActiveCell 
    If check_value = "5" Then 
     Cells(Application.ActiveCell.Row, 1).Copy 
     'The destination set is in sheet SOC 5 
     Sheets("SOC 5").Select 
     RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row 
     Range("a" & RowCount + 1).Select 
     ActiveSheet.Paste 
     Sheets("Data").Select 
    End If 
    Next 
End Sub 

Answer 1

Sub Cond5CopyNew() 
Dim wsSource As Worksheet 
Dim wsDest As Worksheet 
Dim rowCount As Long 


Set wsSource = Worksheets("Data") 
Set wsDest = Worksheets("SOC 5") 


Application.ScreenUpdating = False 

With wsSource 
    rowCount = .Cells(.Cells.Rows.Count, "a").End(xlUp).Row 

    For i = 1 To rowCount 
     If .Cells(i, "BH").Value = 5 Then 
      'Second check, make sure it's not already copied 
      If WorksheetFunction.CountIf(wsDest.Range("A:A"), .Cells(i, "A").Value) = 0 Then 
       'Copy the row over to next blank row 
       .Cells(i, "A").Copy wsDest.Cells(.Rows.Count, "A").End(xlUp).Offset(1) 
      End If 
     End If 
    Next i 
End With 

Application.ScreenUpdating = True 

End Sub 

Answer 2

：

Dim s as Worksheet, d as Worksheet, LRs as Long, LRd as Long 
Set s = Sheets("Data") 's for Source 
Set d = Sheets("SOC 5") 'd for Destination 
LRs = s.Cells(s.Rows.Count, "A").End(xlUp).Row 'last row of source 
For i = 1 to LRs 
    If s.Cells(i, "BH") = 5 Then 
     LRd = d.Cells(d.Rows.Count, "A").End(xlUp).Row 'last row of destination 
     s.Rows(i).Copy d.Rows(LRd + 1) 
    End If 
Next i 

---

をあなたが最新のデータを確認するためにこれを使用することができます：Aでabritraryルックアップを使用し

Dim s as Worksheet, d as Worksheet, LRs as Long, LRd as Long 
Set s = Sheets("Data") 's for Source 
Set d = Sheets("SOC 5") 'd for Destination 
LRs = s.Cells(s.Rows.Count, "A").End(xlUp).Row 'last row of source 
LRd = d.Cells(d.Rows.Count, "A").End(xlUp).Row 'last row of destination 
For i = 1 to LRd 
    If d.Cells(i, "B") = Application.Index(s.Range(s.Cells(1, "B"), s.Cells(LRs, "B")), Application.Match(d.Cells(i, "A"), s.Range(s.Cells(1, "A"), s.Cells(LRs, "A")),0)) Then 
     s.Rows(Application.Match(d.Cells(i, "A"), s.Range(s.Cells(1, "A"), s.Cells(LRs, "A")),0)).Copy d.Rows(i) 
    End If 
Next i 

を（マッチ）とB（インデックス）の出力とを比較する。

Answer 3

固有の値リストが必要なようです。辞書オブジェクトの使用を検討しましたか？ Excel VBAの辞書オブジェクトには、値が辞書に既に存在するかどうかを確認する方法があります。これにより、ディクショナリに追加する予定の値がディクショナリに存在していないことを確認することで、ユニークな値のみで簡単にディクショナリに値を設定することができます。これはあなたに有望聞こえる場合

が、その後、私はVBAで辞書を使用する方法の詳細については、次のリソースをご覧になることをお勧め：

https://excelmacromastery.com/vba-dictionary/#A_Quick_Guide_to_the_VBA_Dictionary

次が存在している使用することをお勧めします方法：

dict.Exists(Key) 

値がすでに辞書に入っているかどうかを確認する。

この回答が十分でない場合は、必要に応じて詳しく説明してください。