Excelシートのある番地の文字が一致したすべての行を別シートに転記する方法

Question

ｖｂａ初心者です。
ネットで「ｖｂａ複数条件一致」で検索して色々なものを見て自分なりにやってはいるのですが、どうしても思い通りにいきません。
お助けいただけると嬉しいです。

エクセルシートのある番地（例えば：E6)に記載されている文字が一致したものすべての行を別シートに転記する方法を調べていますが、全く分かりません。

もう少し分かりやすく説明しますと例えばE6に『光源氏』という文字が入っているすべての行を『光源氏』の別シートに転記する方法です。このE6には『宮本武蔵』、『明智光秀』等、数種類の文字が入ります。現在、その種類は50くらいあれば足りると思います。

VBAは全く初心者ですので、質問の意味も理解されるかは分かりませんが、わかる範囲で結構ですので教えて下さい。

tatsumaru77 · Accepted Answer

以下のマクロを標準モジュールに登録してください。
シート名は2022.10にしてあります。
変える場合は
Set ws = Worksheets("2022.10")
の行を適切に変えてください。

Option Explicit
Public Sub 出荷団体転記()
    Dim ws As Worksheet
    Dim ts As Worksheet
    Dim maxrow As Long
    Dim wrow As Long
    Dim ret As Boolean
    Dim name As String
    Set ws = Worksheets("2022.10")
    maxrow = ws.Cells(Rows.count, "AP").End(xlUp).Row    'AP列の最大行取得
    If maxrow < 13 Then Exit Sub
    For wrow = 13 To maxrow
        name = ws.Cells(wrow, "AP").Value
        ret = find_sheet(name, ts)
        If ret = False Then
            ws.Activate
            ws.Cells(wrow, "AP").Select
            MsgBox (wrow & "行の" & name & "に一致するシートがありません")
            Exit Sub
        End If
        Call data_copy(ws, wrow, ts)
    Next
    MsgBox ("完了")
End Sub

'指定文字のシートを探す
Private Function find_sheet(ByVal name As String, ByRef ts As Worksheet) As Boolean
    find_sheet = False
    Dim i As Long
    For i = 1 To Worksheets.count
        If LCase(Worksheets(i).name) = LCase(name) Then
            Set ts = Worksheets(i)
            find_sheet = True
            Exit Function
        End If
    Next
End Function
'指定先のシートへ転記する
Private Sub data_copy(ByVal ws As Worksheet, ByVal wrow As Long, ByVal ts As Worksheet)
    Dim lastrow As Long
    Dim trow As Long
    lastrow = ts.Cells(Rows.count, "E").End(xlUp).Row    'E列の最大行取得
    If lastrow < 5 Then lastrow = 5
    trow = lastrow + 1
    ts.Cells(trow, "B").Value = ws.Cells(wrow, "C").Value '日付
    ts.Cells(trow, "C").Value = ws.Cells(wrow, "K").Value '納品日
    ts.Cells(trow, "D").Value = ws.Cells(wrow, "S").Value '売渡先
    ts.Cells(trow, "E").Value = ws.Cells(wrow, "AP").Value '出荷団体
    ts.Cells(trow, "F").Value = ws.Cells(wrow, "BD").Value '産地
    ts.Cells(trow, "G").Value = ws.Cells(wrow, "BJ").Value '生産者
    ts.Cells(trow, "H").Value = ws.Cells(wrow, "BS").Value '平均重量
    ts.Cells(trow, "I").Value = ws.Cells(wrow, "BX").Value '重量
    ts.Cells(trow, "J").Value = ws.Cells(wrow, "CA").Value '外葉
    ts.Cells(trow, "K").Value = ws.Cells(wrow, "CD").Value '変色
    ts.Cells(trow, "L").Value = ws.Cells(wrow, "CG").Value '異物
    ts.Cells(trow, "M").Value = ws.Cells(wrow, "CJ").Value '合計点
End Sub

tatsumaru77 · Answer

そうすると、転記元のAP列に
織田信長があったとすると、その行は、シート名：織田信長のシートに転記されます。
そうすると、シート名：織田信長のE列（出荷団体）は、全て、織田信長になりますが、
それであってますか。
下記が、転記のサンプルです。

シート名：2022.10(転記元のシート)
https://gyazo.com/ea51a14d0b82f27cb78e7c8d766afd8f

シート名：織田信長
https://gyazo.com/d54a2d86b804590f4d05fc100a862572

tatsumaru77 · Answer

①>E6は忘れて下さい。例えばのセル番地を適当に入力しただけです。本題はAP～AZに入る色で塗られた部分が一致した場合、同じシートに色毎に転記していくというマクロになります。

②>実際転記元に色は付けませんので、色を含めて転記する予定はありません。

①と②のどちらが正しいのでしょうか。
もし、②が正しいなら、
あなたの提示例では転記元のシートにAP20、AP21、AP22があるとき、
明智光秀のシートに転記するようになっていますが、
色で判断できないとなると、どのようにして、AP20、AP21、AP22を
明智光秀のシートに転記すると判断するのでしょうか。

tatsumaru77 · Answer

AP列と同じ色のシートに転記すると理解しました。
確認事項です。

１．転記元のシートは、常に「2022.10」固定でよろしいでしょうか。
もし、シート名が実行の都度、変わるなら、シート名を決定する方法をご提示ください。

２．転記先のE列（出荷団体）に転記したとき、色も含めて転記しますか。
（そうすると、結果としてE列は同じ色で埋まります）

３．転記先のサンプルをみると、合計点、評価は関数式が埋め込まれているように思われます。
ここにコピーすると関数式がつぶれますが、よろしいでしょうか。

４．転記は原則として値のみコピーを考えてますがそれで良いでしょうか。
（転記元に関数式があっても関数式はコピーされません。また、書式もコピーされません）

tatsumaru77 · Answer

https://gyazo.com/39fab2910c8c93a55009dd27df7f712b
https://gyazo.com/fdb4252e7f338af886f80902d9d6403c
https://gyazo.com/6f8c307552bd562760cdae22087cd63c
上記の画像が転記先ということでしょうか。
そうすると、以下の前提であってますか。
１．転記先は、検索文字ごとに異なる。
検索文字が「光源氏」なら、シート名が「光源氏」のシートへ転記する。
（該当シートがない場合は、エラーなので処理中止）

２．転記先の行は、最後の行の次から転記する。
https://gyazo.com/39fab2910c8c93a55009dd27df7f712b
の画像なら、9行目へ転記する。

３．出荷団体欄の検索対象の文字があるので、
https://gyazo.com/39fab2910c8c93a55009dd27df7f712b
では、出荷団体（E列）はAP20,AP21,AP22のようにサンプルで表示されているが、実際には、全て同じ名前が設定される。
光源氏で検索した場合は、全て、光源氏が設定される。

４．転記元は、結合セルになっていて、転記先は単独セルになっています。
セルの形式が異なるため、行ごとコピーするわけにはいきません。
例えば、納品日は
転記元：K～R
転記先：C
のようになります。
画像では、シート全体がみえないので、
転移対象のものを全て列挙していただけませんでしょうか。
項目名：納品日
転記元：K～R
転記先：C
のように全項目の列挙をお願いいたします。

追伸：これからでかけます。戻りは、夕方になります。

tatsumaru77 · Answer

画像のアップありがとうございました。
>https://gyazo.com/7d264fe098c484c0a1113f7ad3d80b45
これは、４つの画像のうちの一番左側の画像と思います。
１．このシートのシート名は、「2022.10」であってますか。
（以下、その前提で質問します）

２．他の画像（残りの３つ）も、同様にgazo.comにアップしていただけませんでしょうか。

３．シート「2022.10」のE6に検索用文字”光源氏”が記載されていると理解して良いでしょうか。

４．シート「2022.10」の出荷団体欄（AP～AZの結合セル）に、
光源氏とか明智光秀とかの名前が記入されていて、その欄（AP～AZ）を
検索するのでしょうか。

５．同じ色の行を全て転記したいとのことですが、
例えば、光源氏で検索したとき、シート「2022.10」の赤色の行（13,16,17,19行）が対象になったとすると、その行には、全て、”光源氏”が記入されているということで合ってますか。

tatsumaru77 · Answer

＞gyazoを起動して資料を添付しました。これで分かるでしょうか？
アップ先をgazo.comにしてください。ここにアップされても、鮮明な画像にはなりません。
gazo.comにアップしたら、そのＵＲＬを、提示してください。
（私がNo4で提示したようなアップ先のURLです）

tatsumaru77 · Answer

画像が小さくてよく見えません。
gyazo.comを利用すると鮮明な画像がアップ可能です。
gyazo.comを利用されてはいかがでしょうか。
下記はそのサンプルです。
https://gyazo.com/733cc5aa1bdb57d8e65d7ce2bb87033f
画像の内容は本件とは関係ありません。この程度の鮮明な画像になるという例です。
また、何回もアップできるので、４つの画像を１つの画像にまとめる必要もありません。別々にアップが可能です。

tatsumaru77 · Answer

画像の提示ありがとうございました。
画像が小さくてよくわかりません（残念ながら、このサイトは大きい画像をアップするとこのように見づらくなってしまいます）ので、それも含めての質問です。

１．検索を行うのは、１３行から開始であってますか。

２．検索対象の列は、どの列ですか。
（どの列に、光源氏とか宮本武蔵とかが記述されているのでしょうか）
３．
＞色で分けているのは同じ色は同じシートに転記するようにします。
この意味が分かりません、具体的に説明していただけませんでしょうか。

４．例として光源氏で検索して、マッチした行を別シートへ転記したとします。その別シートのイメージも画像としてアップしていただけませんでしょうか。（別シートの１行目から書き出すのかどうか等が判りません）

５．提示された画像のシートはE6に検索用の文字があると理解しています。
このシートのシート名はなんでしょうか。

６．別シートへ書き出すときの、別シートのシート名は何でしょうか。

tatsumaru77 · Answer

シートのレイアウトが判りません。
レイアウトのわかる画像を提示していただけませんでしょうか。
検索対象の列はどの列か。（１列だけかそれとも複数列あるのか）
検索開始の行は何行目からか。（７行目からのようにも思えるが不明）
現在わかっているのは、E６に検索用の文字があるということだけです。

Excelシートのある番地の文字が一致したすべての行を別シートに転記する方法

以下のマクロを標準モジュールに登録してください。

そうすると、転記元のAP列に

①>E6は忘れて下さい。

AP列と同じ色のシートに転記すると理解しました。

画像のアップありがとうございました。

＞gyazoを起動して資料を添付しました。

画像が小さくてよく見えません。

画像の提示ありがとうございました。

シートのレイアウトが判りません。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング