[[20231102085244]]　『別のリストを２つの条件で検索し、検索結果を元の』（ダウニー）　ページの最後に飛ぶ

『別のリストを２つの条件で検索し、検索結果を元のリストに抽出』（ダウニー）

リストX、リストYという２つのWorkbookがあります。
Xのsheet1リストのB列に顧客コード、C列に電話番号、H列に発送済という項目があり、5000件くらいのデータが入っています。
Yのsheet1のリストにはA列に顧客コード、B列に電話番号が入っています。（50件くらい）

Yのリストの顧客コード（A列）、電話番号（B列）に完全一致するデータを
Xのリストから探し出し、もしH列に「発送済」と記入されていたら、
YのリストのC列に「完了」と記入したいです。

for～Next、Findなどを使うのかもしれないと思ってはいるのですが、
VBA初心者のため、類似の過去投稿を探すことも出来ず、こちらでお尋ねしてしまいました。
よろしくお願い致します。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

 Option Explicit

 Sub a()

    Dim ShtX As Worksheet
    Dim ShtY As Worksheet
    Dim lastrowX As Long
    Dim lastrowY As Long
    Dim i As Long
    Dim j As Long

    Workbooks.Open ThisWorkbook.Path & "\リストX.xlsx"

    Set ShtX = Workbooks("リストX.xlsx").Worksheets("Sheet1")
    Set ShtY = ThisWorkbook.Worksheets("Sheet1")
    lastrowX = ShtX.Cells(Rows.Count, 2).End(xlUp).Row
    lastrowY = ShtY.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastrowY
        For j = 2 To lastrowX
            If ShtX.Cells(j, 2) = ShtY.Cells(i, 1) And ShtX.Cells(j, 3) = ShtY.Cells(i, 2) Then ShtY.Cells(i, 3) = "完了"
        Next j
    Next i

    Workbooks("リストX.xlsx").Close

 End Sub

リストYからリストXを参照する前提で。
リストYに上記のコードを配置します。
リストXとリストYは同じフォルダにあるとします。
それぞれのシート名はSheet1とします。
エラー処理はしてません。

（ゆたか） 2023/11/02(木) 11:34:34

それぞれの１行目はタイトル行と考えたので2行目から処理を行っています。
（ゆたか） 2023/11/02(木) 11:35:41

失礼、発送済みをチェックしてなかった(^^;
（ゆたか） 2023/11/02(木) 11:43:54

 （誤）If ShtX.Cells(j, 2) = ShtY.Cells(i, 1) And ShtX.Cells(j, 3) = ShtY.Cells(i, 2) Then ShtY.Cells(i, 3) = "完了"
 （正）If ShtX.Cells(j, 2) = ShtY.Cells(i, 1) And ShtX.Cells(j, 3) = ShtY.Cells(i, 2) And ShtX.Cells(i, 8) = "発送済" Then ShtY.Cells(i, 3) = "完了"

これでいけると思います。
（ゆたか） 2023/11/02(木) 11:51:42

 （誤）If ShtX.Cells(j, 2) = ShtY.Cells(i, 1) And ShtX.Cells(j, 3) = ShtY.Cells(i, 2) And ShtX.Cells(i, 8) = "発送済" Then ShtY.Cells(i, 3) = "完了"
 （正）If ShtX.Cells(j, 2) = ShtY.Cells(i, 1) And ShtX.Cells(j, 3) = ShtY.Cells(i, 2) And ShtX.Cells(j, 8) = "発送済" Then ShtY.Cells(i, 3) = "完了"

再び、間違っていました。ShtXのインデックスはjでした。
テストではたまたまうまく行ってしまいました。
（ゆたか） 2023/11/02(木) 12:10:40

ゆたかさん

ありがとうございます。動作しました。

処理が完了するのに
2、3分かかり(素人なのでちょっと不安になりました)。
おそらく5000件を1つずつチェックしてるからだとは思うのですが、
Yのリストは将来的に増え続ける予定ですので、
今よりも処理に時間がかかりそうです。

ただし目でチェックするよりは遥かに早いですので助かります。
（ダウニー） 2023/11/02(木) 14:38:36

高速にするには、一旦シートから配列に格納して処理してからシートに書き戻すという方法もあります。

とりあえず、処理中は画面更新を止めて見てください。

 Workbooks.Open ThisWorkbook.Path & "\リストX.xlsx"

の直前に

 Application.ScreenUpdating = False

を挿入。

 Workbooks("リストX.xlsx").Close

の直後に

 Application.ScreenUpdating = True

を挿入してみてください。

こうすると、その２行の間では画面更新を行わないので速くなります（多くの場合）
（ゆたか） 2023/11/02(木) 14:52:41

 Sub test()
    Dim dic As Object
    Dim v, k As Long
    Dim r As Range

    Set dic = CreateObject("scripting.dictionary")

    With Workbooks.Open(ThisWorkbook.Path & "\リストX.xlsx")
        v = .Worksheets("Sheet1").Cells(1).CurrentRegion.Resize(, 8).Value
        For k = 2 To UBound(v)
            If v(k, 8) = "発送済" Then
                dic(v(k, 2) & vbTab & v(k, 3)) = True
            End If
        Next
        .Close False
    End With

    Set r = ThisWorkbook.Worksheets("Sheet1").Cells(1).CurrentRegion.Resize(, 3)
    v = r.Value
    For k = 2 To UBound(v)
        If dic.exists(v(k, 1) & vbTab & v(k, 2)) Then
            v(k, 3) = "発送済"
        End If
    Next
    r.Value = v

 End Sub
（マナ） 2023/11/02(木) 15:12:50

マナさん

ありがとうございます。
コピペで試してみたところ、こちらでもできました。

ちなみに、実物のリストは４行目にヘッダーがあり、
データが5行目から始まっているので
試しに「For k = 5 To UBound(v)」としたところ、
結果が反映されなくなってしまいました。

変更する箇所が間違っておりますでしょうか。
（ダウニー） 2023/11/02(木) 17:36:08

 Sub test2()
    Dim dic As Object
    Dim v, k As Long
    Dim r As Range

    Set dic = CreateObject("scripting.dictionary")

    With Workbooks.Open(ThisWorkbook.Path & "\リストX.xlsx").Worksheets("Sheet1")
        v = .Range("A5", .Cells(Rows.Count, 1).End(xlUp)).Resize(, 8).Value
        For k = 1 To UBound(v)
            If v(k, 8) = "発送済" Then
                dic(v(k, 2) & vbTab & v(k, 3)) = True
            End If
        Next
        .Parent.Close False
    End With

    With ThisWorkbook.Worksheets("Sheet1")
        Set r = .Range("A5", .Cells(Rows.Count, 1).End(xlUp)).Resize(, 3)
    End With
    v = r.Value
    For k = 1 To UBound(v)
        If dic.exists(v(k, 1) & vbTab & v(k, 2)) Then
            v(k, 3) = "発送済"
        End If
    Next
    r.Value = v

 End Sub
（マナ） 2023/11/02(木) 18:19:07

ゆたかさん
ありがとうございます、おかげ様で若干早くなりました。

マナさん
ありがとうございます。
発送済 ⇒ 完了と置き換えることで実現できました。
早かったです＾＾

両方とも同じ結果が実現できました。
メンテの面でも考慮してどちらを採用するか
担当のメンバー間で検討してみたいと思います。
大変お世話になりました。
（ダウニー） 2023/11/06(月) 18:26:26

マナさんの案について。
追加で、XのリストのI列に発送コードがあります。
発送済みの場合は、発送コードをYのリストのD列に転記したい場合、
最後の「発送済み」のところにどんな一文を追記すればよろしいのでしょうか？
配列に詳しくなく、ご教授いただけますと助かります。
（ダウニー） 2023/11/10(金) 17:17:18

 Sub test3()
    Dim dic As Object
    Dim v, k As Long
    Dim r As Range

    Set dic = CreateObject("scripting.dictionary")

    With Workbooks.Open(ThisWorkbook.Path & "\リストX.xlsx").Worksheets("Sheet1")
        v = .Range("A5", .Cells(Rows.Count, 1).End(xlUp)).Resize(, 9).Value
        For k = 1 To UBound(v)
            If v(k, 8) = "発送済" Then
                dic(v(k, 2) & vbTab & v(k, 3)) = v(k, 9)
            End If
        Next
        .Parent.Close False
    End With

    With ThisWorkbook.Worksheets("Sheet1")
        Set r = .Range("A5", .Cells(Rows.Count, 1).End(xlUp)).Resize(, 4)
    End With
    v = r.Value
    For k = 1 To UBound(v)
        If dic.exists(v(k, 1) & vbTab & v(k, 2)) Then
            v(k, 3) = "完了"
            v(k, 4) = dic(v(k, 1) & vbTab & v(k, 2))
        End If
    Next
    r.Value = v
 End Sub
（マナ） 2023/11/10(金) 18:10:50

マナさん

速攻で回答頂きありがとうございます。
一文追加だけではなかったのですね、
やりたかったことが実現できました。

何度もありがとうございます。
感謝いたします。
（ダウニー） 2023/11/10(金) 18:34:16

お世話になっております。

マナさんに頼ってしまうかもしれませんが…（何度も何度もすみません、考慮漏れがありました）

    With ThisWorkbook.Worksheets("Sheet1")
        Set r = .Range("A5", .Cells(Rows.Count, 1).End(xlUp)).Resize(, 4)
    End With
    v = r.Value
    For k = 1 To UBound(v)
        If dic.exists(v(k, 1) & vbTab & v(k, 2)) Then
            v(k, 3) = "完了"
            v(k, 4) = dic(v(k, 1) & vbTab & v(k, 2))
        End If
    Next
    r.Value = v

実物のリストは４行目にヘッダーがあり、データが5行目から始まっているので
初回は「A5」部分開始でも良いのですが、リストは随時更新されてA列に情報が積みあがっていきます。
C列に「完了」が入っていない、かつ、A列が空白以外を処理の対象とするには
どのような指定を行え場宜しいでしょうか？
（ダウニー） 2023/11/16(木) 11:49:30

 念のため、現状の問題点を具体例をあげれ説明してください。
（マナ） 2023/11/16(木) 20:24:20

マナさん

いろいろいじりながら考えてみた結果、特に問題ありませんでした。
お騒がせして申し訳ございませんでした。
（ダウニー） 2023/11/17(金) 19:15:25

コメント返信：

[ 一覧(最新更新順) ]

[[20231102085244]] 『別のリストを２つの条件で検索し、検索結果を元の』（ダウニー） ページの最後に飛ぶ

[[20231102085244]]　『別のリストを２つの条件で検索し、検索結果を元の』（ダウニー）　ページの最後に飛ぶ