Results of 1 - 1 of about 8929 for リスト (0.007 sec.)
- [[20231102085244]]
- #score: 2746
- @digest: 53d6c57b68e9e7612936d6ecf2d6f983
- @id: 95438
- @mdate: 2023-11-17T10:15:25Z
- @size: 8411
- @type: text/plain
- #keywords: shty (67484), 送済 (61671), shtx (59046), トx (37909), ウニ (34234), lastrowy (22494), lastrowx (22494), 発送 (17839), トy (17225), 済" (12215), 客コ (6371), 了" (5537), ニー (5294), vbtab (5211), （ダ (4476), 実物 (4422), リス (3437), 完了 (3141), 2023 (2410), マナ (2380), スト (2315), cells (2287), thisworkbook (2132), ） if (2080), workbooks (2066), ダウ (2046), 話番 (1824), 電話 (1593), 木) (1405), ナさ (1345), dic (1340), ヘッ (1328)
- 『別のリストを2つの条件で検索し、検索結果を元のリストに抽出』（ダウニー）
リストX、リストYという2つの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 ---- それぞれの1行目はタイトル行と考えたので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 を挿入してみてください。 こうすると、その2行の間では画面更新を行わないので速くなります（多くの場合） （ゆたか） 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 ---- マナさん ありがとうございます。 コピペで試してみたところ、こちらでもできました。 ちなみに、実物のリストは4行目にヘッダーがあり、 データが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 実物のリストは4行目にヘッダーがあり、データが5行目から始まっているので 初回は「A5」部分開始でも良いのですが、リストは随時更新されてA列に情報が積みあがっていきます。 C列に「完了」が入っていない、かつ、A列が空白以外を処理の対象とするには どのような指定を行え場宜しいでしょうか? （ダウニー） 2023/11/16(木) 11:49:30 ---- 念のため、現状の問題点を具体例をあげれ説明してください。 （マナ） 2023/11/16(木) 20:24:20 ---- マナさん いろいろいじりながら考えてみた結果、特に問題ありませんでした。 お騒がせして申し訳ございませんでした。 （ダウニー） 2023/11/17(金) 19:15:25... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202311/20231102085244.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97040 documents and 608209 words.
訪問者：