不足分データを別シートに追記

Question

Sheet1にSheet2にあって足らないデータを追記できるものを作っていますが、
Or以降のsh1.Cells(n, "A") = sh2.Cells(I, "A") And sh1.Cells(n, "L") <> sh2.Cells(I, "F")
の判定がうまくいきません。
A列で同じデータでも、もう一列で違うデータの場合には不足分とし追記できるようにしたいと考えています。
どこがいけないかわからないのでよろしくお願いします。

Sub 転記()
Dim sh1 As Worksheet
 Dim sh2 As Worksheet
Start = Time
 Set sh1 = Worksheets("Sheet1")
 Set sh2 = Worksheets("Sheet2")
   
 R1 = sh1.Cells(sh1.Rows.Count, "A").End(xlUp).row
 R2 = sh2.Cells(sh2.Rows.Count, "A").End(xlUp).row
 Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 n = R1 + 1
 For I = 1 To R2
 Set x = sh1.Range(sh1.Cells(1, "A"), sh1.Cells(R1, "A")).Find(What:=sh2.Cells(I, "A"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
 If x Is Nothing And sh2.Cells(I, "AB") <> "" Or _
  sh1.Cells(n, "A") = sh2.Cells(I, "A") And sh1.Cells(n, "L") <> sh2.Cells(I, "F") And sh2.Cells(I, "AB") <> "" Then
        sh1.Cells(n, "A") = sh2.Cells(I, "A")
        sh1.Cells(n, "B") = sh2.Cells(I, "B")     
 n = n + 1
 End If
 Next I
 Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 Finish = Time
MsgBox "取得が完了しました" & vbLf & "実行時間は" & Format(Finish - Start, "nn分ss秒") & "でした" 
 End Sub

Answer 1

すみません。１点見落としました。
A列の検索は大文字／小文字を区別して検索しますか。
もし、そうなら、
MatchCase:=True
にしてください。
区別しないなら、転記２のほうの修正が必要になります。その時は、その旨返信ください。

Answer 2

連投になります。前回と同じ機能をdictionaryを使って実装しました。
まず、同じ結果になることを確認してください。そして、実行時間を確認してください。

Option Explicit
Sub 転記2()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim dicT As Object
    Dim Start As Date
    Dim Finish As Date
    Dim lrow As Long
    Dim I As Long
    Dim n As Long
    Dim R1 As Long
    Dim R2 As Long
    Dim key As Variant
    Start = Time
    Set dicT = CreateObject("Scripting.Dictionary")
    Set sh1 = Worksheets("Sheet1")
    Set sh2 = Worksheets("Sheet2")

    R1 = sh1.Cells(sh1.Rows.Count, "A").End(xlUp).Row
    R2 = sh2.Cells(sh2.Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For lrow = 2 To R1
        key = sh1.Cells(lrow, "A").Value & "|" & sh1.Cells(lrow, "L").Value
        dicT(key) = True
    Next
    n = R1 + 1
    For I = 2 To R2
        If sh2.Cells(I, "AB").Value <> "" Then
            key = sh2.Cells(I, "A").Value & "|" & sh2.Cells(I, "F").Value
            If dicT.exists(key) = False Then
                sh1.Cells(n, "A").Value = sh2.Cells(I, "A").Value
                sh1.Cells(n, "B").Value = sh2.Cells(I, "B").Value
                n = n + 1
            End If
        End If
    Next I
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Finish = Time
    MsgBox "取得が完了しました" & vbLf & "実行時間は" & Format(Finish - Start, "nn分ss秒") & "でした"
End Sub

Comments

[hajihaji]

ご回答ありがとうございます。うまくいくました。
dictionaryの使い方がいまいちわかってないのでじっくりコードを読んで勉強させていただきます。

[hajihaji]

もしお答えいただけましたらご教示いただきたいのですが、
key = sh1.Cells(lrow, "A").Value & "|" & sh1.Cells(lrow, "L").Value
の"|"とはどのような意味なのでしょうか。

[tatsu99]

以下の理由です。
Aの項目とLの項目を連結して１つのキーにしますが、直接連結すると、
Aの項目＝AB、Lの項目＝CDの場合、連結結果＝ABCD
Aの項目＝ABC、Lの項目＝Dの場合、連結結果＝ABCD
となり、同じ連結結果になってしまします。
それは、望んだ結果ではありません。
それを防止する為に、｜をいれて
Aの項目＝AB、Lの項目＝CDの場合、連結結果＝AB｜CD
Aの項目＝ABC、Lの項目＝Dの場合、連結結果＝ABC｜D
とすると、異なる連結結果が得られます。
区切り文字は｜でなくても構いませんが、通常、データとして使われない文字を選択します。

[hajihaji]

ご回答ありがとうございます。
大変勉強になります。

Answer 3

＞Sheet2のF列の値がSheet1のL列と異なり・・・・の箇所のがうまくいかず転記しません。コードｎがいけないのでしょうか。
nはこれから設定する箇所のセルの行です。その行を参照すること自体がおかしいです。
あなたのソースのおかしいところを修正しました。
こちらでになります。

Sub 転記()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Start = Time
    Set sh1 = Worksheets("Sheet1")
    Set sh2 = Worksheets("Sheet2")

    R1 = sh1.Cells(sh1.Rows.Count, "A").End(xlUp).Row
    R2 = sh2.Cells(sh2.Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    n = R1 + 1
    For I = 2 To R2
        flag = flase
        Set x = sh1.Range(sh1.Cells(2, "A"), sh1.Cells(R1, "A")).Find(What:=sh2.Cells(I, "A"), LookIn:=xlValues, LookAt:= _
                                                                      xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        If x Is Nothing Then
            If sh2.Cells(I, "AB") <> "" Then flag = True
        Else
            If x.Value = sh2.Cells(I, "A") And x.Offset(0, 11).Value <> sh2.Cells(I, "F") And sh2.Cells(I, "AB") <> "" Then
                flag = True
            End If
        End If
        If flag = True Then
            sh1.Cells(n, "A") = sh2.Cells(I, "A")
            sh1.Cells(n, "B") = sh2.Cells(I, "B")
            n = n + 1
        End If
    Next I
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Finish = Time
    MsgBox "取得が完了しました" & vbLf & "実行時間は" & Format(Finish - Start, "nn分ss秒") & "でした"
End Sub

Comments

[hajihaji]

ご回答ありがとうございます。
重複して転記してしまうようです。
わたしの知識が追いつかないので、今しばらくどこがどうなっているのかコードを見てみます。
ありがとうございます。

Answer 4

１．コピー対象となるSheet2の行の条件は何でしょうか。
１）Sheet2のA列の値がSheet1になく、Sheet2のAB列の値が空白でない行。
２）Sheet2のA列の値がSheet1のA列と同じ、かつ
Sheet2のF列の値がSheet1のL列と異なり、かつ
Sheet2のAB列の値が空白でない行。
上記の１），２）の何れかが成立する行でしょうか。（ソースからの推定です）
それとも、上記と異なるならその旨記述してください。

２．コピー対象となった行は、その行ごと転記するのでしょうか。
又、転記するときは値のみの転記でしょうか。それとも、全て（値、関数名、書式等）転記でしょうか。
値のみの転記であれば、A列から何列まで転記すれば良いのでしょうか。
それとも、A列とB列だけ転記するのでしょうか。

３．Sheet1,Sheet2共に１行目からデータとなっていますか。（１行目は見出し行ではない）

上記のことを確認したくて、「その要件を正確に書いていただけませんでしょうか。」とお願いいたしました。

Comments

[hajihaji]

ご返答ありがとうございます。
１．はい、その認識で結構です。
２．値をＡ、Ｂ列だけです。※実際にはそれぞれ双方で入り組んだ配置になります。
３．双方一行目は見出しです。
　失礼いたしました。
Sheet2のF列の値がSheet1のL列と異なり・・・・の箇所のがうまくいかず転記しません。コードｎがいけないのでしょうか。

Answer 5

＞Sheet1にSheet2にあって足らないデータを追記できるものを作っています
その要件を正確に書いていただけませんでしょうか。
たぶん、Findは使わずに、Scripting.Dictionaryを使った方が早く終わるかと思います。

Comments

[hajihaji]

お返事ありがとうございます。
複数列で判定をし、ダブりのないようにSheet2→Sheet1へ追記していくものです。
先にご提示いたしましたものは、まずSheet1とSheet2のA列同士で比較し、差異分を追記。
次に、A列にすでにあるコードでも、もうひとつ判定条件を加えております。
二番目の判定がどうもうまくいきません。
Scripting.Dictionaryの使用例などございましたらご教示いただければと存じます。