条件つきで、vlookup的操作を実行するマクロ？

質問

「データー」（シート名）の、A列の数値が、
　「閲覧」（シート名）の、cell（"C55")の数値と一致したならば、

　「データー」の、該当行のH,I,J,K列のcell valueを、
　「閲覧」の５７行目のA,C,E,K列に、
　それぞれコピーする。（値を同じにする）

　というマクロを組みたいと思っています。

　少し厄介なのが
　「「閲覧」の、cell（"C55")の数値と一致」するケースが、０もしくは複数（最大２０個）あるということです。
　　↓
　該当データーを「閲覧」の５７行目に貼り付けて（値を同じにして）、
　そしてまだ「データー」に、「C５５と一致する」ものが会った場合は、次は５８行目に同様の操作を施す、、、ということをやろうと思っています。

　　このような場合、
　　どういったマクロを組めばよいものか、アドバイスをいただけると、大変ありがたく思います。

　　どうぞ、よろしくお願いいたします。

回答No.3

tom04 · ベストアンサー

No.1です。

＞◇AB列　◇CD列　◇EFGHIJ列　◇KLMNO列　は、それぞれ結合している。】
というコトですので、
セルをクリアする行でエラーになると思います。

通常セルを結合すると、結合セルの一番最初がセル番地になりますが、
クリアする場合だけ結合セルの最後まで範囲指定しないと、そのようなエラーが発生すると思います。

そこでもう一度コードを載せてみます。
（今回は「閲覧」SheetのC55セルデータが「データ」SheetのA列にない場合、メッセージを表示するようにしてみました。）

Sub test() 'この行から
Dim i As Long, k As Long, ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("データ")
Set ws2 = Worksheets("閲覧")
k = ws2.Cells(Rows.Count, 1).End(xlUp).Row
If k > 56 Then
Range(ws2.Cells(57, "A"), ws2.Cells(k, "O")).ClearContents
End If
If WorksheetFunction.CountIf(ws1.Columns(1), ws2.Cells(55, "C")) Then
k = 56
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
If ws1.Cells(i, 1) = ws2.Cells(55, "C") Then
k = k + 1
ws2.Cells(k, "A") = ws1.Cells(i, "H")
ws2.Cells(k, "C") = ws1.Cells(i, "I")
ws2.Cells(k, "E") = ws1.Cells(i, "J")
ws2.Cells(k, "K") = ws1.Cells(i, "K")
End If
Next i
Else
MsgBox "該当データがありません。"
End If
End Sub 'この行まで

これではどうでしょうか？m（_ _）m

お礼

見事、解決いたしました。
　どこに問題があったのか見比べて、
　ますます、このエクセルの数式についての理解が深まりました。

　本当に助かりました。
　オンライン上で、質問投稿をして、ここまで助けてくださって、
　とても感謝をしております。

　どうも、ありがとうございました。

　m(_ _)m

回答No.2

matsu_jun

penichi さん、おはようございます。

マクロで導出する方法は皆様から得られることと存じます。

ここではおまけとして、マクロを利用せずに、数式で実現する方法をご紹介しましょう。
まずは、「閲覧」シートに、作業列（1列丸々数式を入れても影響の無い列、運用時は列を非表示にする）を設けることができることを前提とします。ここでは、L列を作業列として利用します。

また、検索の対象となるA列についても、「最大20個」という表現から、A1からA20までと仮定します。

このとき、L57セルに以下の値を入力します。L55セルには20を、L56セルには0を記入して下さい。

=L56+MATCH($C$55,INDIRECT("データー!$A$"&L56+1&":$A$"&$L$55),0)

A列の検索開始行が1行目からでなく、例えば5行目だったときは、L56セルに、5から1を引いた値、すなわち4を入れてください。また、検索終了行が20行目でなく、例えば30行目だったときは、L55セルに30を入力します。
作業列として、L列でなく他の列を指定した場合は、数式中に2箇所「L56」、1箇所「$L$55」と書かれた部分がありますので、そこを書き換えてください。

それが済んだら、L57をクリックし、下へ必要分（題記だと20個分）ドラッグして式をコピーしてください。
そうすれば、「閲覧」シートのC55の値が、「データー」シートのA列何行目に存在するかの一覧が表示されるはずです。（A列の最終行以外の値を検索しているときは、下のほうは、「#N/A」と表記されているはずです。ちなみに最終行の値を検索しているときは、「#N/A」は表示されませんが、問題ありません）

次に、「閲覧」シートのA57に、

=IF(ISNA(L57),"",IF(L57>$L$55,"",OFFSET(データー!$A$1,閲覧!L57-1,7,1,1)))

と入力します。こちらも、作業列としてL以外を指定した場合は、修正してください。都合4箇所修正があるはずです。

C列、E列、K列にも同様に、
=IF(ISNA(L57),"",IF(L57>$L$55,"",OFFSET(データー!$A$1,閲覧!L57-1,8,1,1)))
=IF(ISNA(L57),"",IF(L57>$L$55,"",OFFSET(データー!$A$1,閲覧!L57-1,9,1,1)))
=IF(ISNA(L57),"",IF(L57>$L$55,"",OFFSET(データー!$A$1,閲覧!L57-1,10,1,1)))

と入力します。（A列同様、作業列がLで無い場合は、修正をしてください）

それぞれを下へつまんで、式をコピーしてください。こちらも20行分で良いでしょう。

もしマクロを使ってはいけない環境であった場合は、ご参照いただければ幸いです。

お礼

あ～。なるほど、です！
私が知っていたのは、vlookupばかりだったので、
その他の関数の可能性に思いが至りませんでした。

今回は、マクロで、このままいけそうなのですが、
またこれとは別の機会に、教えていただいたことを、活用することになりそうです。
しっかりと覚えておきます。

ご回答、どうもありがとうございました！

回答No.1

tom04

こんにちは！
一例です。

Alt＋F11キー　→　画面左の「This Workbook」をダブルクリック　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。

尚、Sheet名「データー」は「データ」にしています。
データSheetのデータは2行目以降にあるとしています。

Sub test() 'この行から
Dim i As Long, k As Long, ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("データ")
Set ws2 = Worksheets("閲覧")
k = ws2.Cells(Rows.Count, 1).End(xlUp).Row
If k > 56 Then
Range(ws2.Cells(57, "A"), ws2.Cells(k, "K")).ClearContents
End If
k = 56
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
If ws1.Cells(i, 1) = ws2.Cells(55, "C") Then
k = k + 1
With ws2.Cells(k, 1)
.Value = ws1.Cells(i, "H")
.Offset(, 2) = ws1.Cells(i, "I")
.Offset(, 4) = ws1.Cells(i, "J")
.Offset(, 10) = ws1.Cells(i, "K")
End With
End If
Next i
End Sub 'この行まで

こんな感じではどうでしょうか？

※　閲覧SheetのA57セル～K列最終行のデータを一旦クリアにし、新たに57行目以降に表示するようにしていますので、
もし、他の列（E・D・F～J列）に消してはいけないデータがある場合は
コードを変更する必要があります。

参考になりますかね？m（_ _）m

お礼

大変に、助かっております。
　ほぼうまくいきました。

　一つだけ、問題がございます。

　ここのくだりについてなのですが、
　私が質問において説明していなかった事として…
【57行目以降について
　◇AB列　◇CD列　◇EFGHIJ列　◇KLMNO列　は、それぞれ結合している。】
　・・・といった状況がございます。

　おそらくこのためだと思われるのですが、

If k > 56 Then
Range(ws2.Cells(57, "A"), ws2.Cells(k, "K")).ClearContents
End If

　…この命令を実行する時点で、
　「結合セルの内容の一部？を変更することはできません…」といったメッセージが表示されます。
　（なぜかアメリカのエクセルなので”cannot change the part of merged cell"という警告がなされます）

　結合を解除したり、
　再び結合をしたりする…恥ずかしいほど原始的なマクロを作成すれば…この問題に対処できるのですが、
　可能ならば、
　ここの部分の解決策を教えていただければと思います。

　本当にどうもありがとうございます。