Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 11全般 : 指定なし)
特定の文字列を別シート内から検索し、該当セルの横の列のセル内容をコピーする
投稿日時: 24/06/10 11:32:15
投稿者: KMYC

先日VBAエキスパートベーシックに合格した初心者です。
自分のやりたいことはなんと検索したら良いかも検討がつかず、質問させて頂きます。
 
「Sheet1」のA列に文字列、B列に「◯,×」のどちらかが記入されているリストがあり、
A列の文字列は別シート「Sheet2」のA列にも記載があり、関連する内容がB列に1行だけ記載されている
というExcelファイルがあるとします。
 
「Sheet1」のB列が「◯」のとき、
「Sheet1」のA列の文字列を「Sheet2」A列内で検索し、
該当があったセルの隣のセルをコピーして「Sheet3」のA1から貼り付けていく
 
というマクロを組みたいのですが、伝わりますでしょうか。。。
Sheet3のA1から貼り付けていくときの繰り返しも難しく。

回答
投稿日時: 24/06/10 13:38:26
投稿者: sk

引用:
「Sheet1」のA列に文字列、B列に「◯,×」のどちらかが記入されているリストがあり

-------------------------------------------------
	A	B
1	商品番号	購入希望
2	C001	×
3	C002	○
4	C003	×
5	C004	×
6	C005	○
7	C006	×
8	C007	○
9	C008	○
10	C009	×
11	C010	○
-------------------------------------------------

 
引用:
A列の文字列は別シート「Sheet2」のA列にも記載があり、関連する内容がB列に1行だけ記載されている

-------------------------------------------------
	A	B
1	商品番号	商品名
2	C001	きのこの山
3	C002	たけのこの里
4	C003	チョコボール ピーナッツ
5	C004	チョコボール キャラメル
6	C005	チョコボール いちご
7	C006	ポッキー
8	C007	ジャイアントカプリコ
9	C008	セコイヤチョコレート ミルク
10	C009	セコイヤチョコレート ホワイト
11	C010	サク山チョコ次郎
-------------------------------------------------

 
引用:
「Sheet1」のB列が「◯」のとき、
「Sheet1」のA列の文字列を「Sheet2」A列内で検索し、
該当があったセルの隣のセルをコピーして「Sheet3」のA1から貼り付けていく

-------------------------------------------------
	A	B	C
1	商品番号	購入希望	商品名
2	C002	○	たけのこの里
3	C005	○	チョコボール いちご
4	C007	○	ジャイアントカプリコ
5	C008	○	セコイヤチョコレート ミルク
6	C010	○	サク山チョコ次郎
-------------------------------------------------

 
以上のような結果を得たい、ということでしょうか。

回答
投稿日時: 24/06/10 13:59:16
投稿者: 竹ちゃん

<関数案> ただし Excel2021以上限定
 
Sheet3
 
A2 =FILTER(Sheet1!A2:B11,Sheet1!B2:B11="○")
 
C2 =IFERROR(XLOOKUP(A2:A11,Sheet2!A2:A11,Sheet2!B2:B11),"")

回答
投稿日時: 24/06/10 16:55:52
投稿者: mattuwan44

詰まっている個所は、
「データの無くなるところまでループする。」
と、
見つかった後、
「出力したいセルを見つけるか。」
かと推察。
 
Sub test()
    Dim c1 As Range
    Dim c2 As Range
    Dim i As Long
     
    '「Sheet1」の使っているセル範囲の2列目の各セルを順に見ていく
    For Each c1 In Worksheets("Sheet1").UsedRange.Columns(2).Cells
        'もし、そのセルの値が「○」であれば、そのときは、
        If c1.Value = "○" Then
            '「Sheet2」の使っているセル範囲の1列目の各セルを順に見ていく
            For Each c2 In Worksheets("Sheet2").UsedRange.Columns(1).Cells
                'もし、Sheet1の「○」だったセル(=c1)の左隣と同じ値ならば、そのときは
                If c1.Offset(, -1).Value = c2.Value Then
                    '書き込み用の行番号を+1する。
                    i = i + 1
                    '見つけたセルの右隣りの値を転記
                    Worksheets("Sheet3").Cells(i, 1).Value = c2.Offset(, 1).Value
                    'ループを抜けて次へいく
                    Exit For
                End If
            Next
        End If
    Next
End Sub
 
こんな感じかと。
 
ポイント>>
1)シート上の使っているセル範囲 → UsedRangeプロパティで取得
2)ループ内で同時に次々なにかを変更する場合は、
  i = i + 1
というような感じで変数を上手く使うとよい。

回答
投稿日時: 24/06/10 20:57:48
投稿者: simple

こういう書き方もあると思います。参考にしてください。
 

Sub test()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim lastRow As Long
    Dim rng As Range
    Dim s As String
    Dim t As Variant
    Dim k As Long
    Dim p As Long

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Set ws3 = Worksheets("Sheet3")
    lastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = ws2.Range("A1").CurrentRegion  '変換テーブル
    p = 1                                    'Sheet3の2行目から書き出し
    
    For k = 2 To lastRow
        If ws1.Cells(k, "B") = "〇" Then
            s = ws1.Cells(k, "A")
            t = Application.VLookup(s, rng, 2, False)
            If Not IsError(t) Then
                p = p + 1
                ws3.Cells(p, "A") = s
                ws3.Cells(p, "B") = t
            Else
                Debug.Print s & " はテーブルにありませんでした"
            End If
        End If
    Next
End Sub

ワークシート関数 VLOOKUP を使った例を書きました。
 
ワークシート関数 を使う場合は、頭にWorksheetFunctionを付けると学習されたかと思います。
エラーにならなければ、Application.ワークシート関数 と同じです。
エラーになる場合の振る舞いが異なります。
下記の即効テクニック記事に書かれていますので、そちらを読んでみて下さい。
https://www.moug.net/tech/exvba/0100035.html
 
私は、On Error Goto xx というのが苦手なので、Application.派です。

回答
投稿日時: 24/06/12 22:06:53
投稿者: simple

まず回答があったら、すべて理解していなくても、
せめて2日程度以内には、簡単な反応をしてください。
事情が変わったのであれば、その説明を簡単にしてください。
 
 
質問者さんにしていただきたいのは、次のようなことです。
 
・回答者から確認の質問があれば、それに返事をしてください。
 
・提示されたコードがあれば、再現してみた結果を書いてください。
  例:
    ・予定したとおりの結果が得られました。
    ・これこれの行でエラーになってしまいます。エラーメッセージはこれこれです。
    ・エラーは出ませんでしたが、
        ・・・・のように想定しておりましたが、
        実際には、・・・のようになってしまいます。
  
・回答に関して、不明点があれば、追加の説明を依頼してください。遠慮は不要です。
  例:
     ・・・・というコードは、何を目的にしているのですか?
     ・・・・のところが理解できません。もう少し説明してください。
     ・・・・のところは、・・・・のように変更してみましたが、これでよかったでしょうか。
            (エラーはでませんし、結果は得られています。)

トピックに返信