エクセルＶＢＡマクロの質問です。

質問

マクロ初心者です。
データ処理のマクロを作ろうとしていて、ちょっと困ってます。
（sheet1)
11 国総　1A (空きセル )
12 化基　２Ｉ　（空きセル）
・
以下、２００程度のデータ
Ｃ列のデータの種類は１０種類

(sheet2)
1A 2 101 102
2I 3 103 104 105
・
・
sheet1のＣ列と同じデータ
Ｃ列より右側のデータ数は１から４個程度

(sheet3)
データなし

sheet1のデータを、sheet3にコピーする際に、各データのＤ列に、sheet2のＣ列の右側のデータを入れていきたいんです。具体的には

(sheet3)
11 国総　1A 101
11 国総　1A 102
12 化基　２Ｉ 103
12 化基　２Ｉ　104
12 化基　２Ｉ　105

っていう感じです。先日、こちらのカテゴリでなく、間違えてＶＢＡプログラムの方に質問して、「板違いですよ」と諭されながらも、ご協力いただきsheet2の件数分増やしてコピーするコードまではたどり着いたのですが、その後、どうすればＤ列に移せるのかで悩んでます。ちなみに、いまたどりついたコード文は以下の通りです。
一度、このコード文の続きで、sheet3のＣ列を条件カウントするコードを作ってみたんですが、動いてくれませんでした。

Sub Re8928577a()
Dim M4 As Range
Dim P As Variant　'　WorksheetFunction.VLookup
Dim Kensaku As String
Dim L As Long
Dim PRow As Long
Dim i As Long
Dim Z As Long

　　Set M4 = Sheets("Sheet2").Range("A1:B30")
　　L = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row　'

　　For Z = 1 To L - 1
　　　　Kensaku = Sheets("Sheet1").Cells(Z + 1, 3).Value
　　　　P = WorksheetFunction.VLookup(Kensaku, M4, 2, False)
　　　　PRow = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　For i = PRow + 1 To PRow + P
　　　　　　　　Sheets("Sheet1").Rows(Z + 1).Copy Sheets("Sheet3").Rows(PRow + 1).Resize(P)
Next i
　　Next Z

End Sub

回答No.2

real beatin（@realbeatin）

＃１です。お礼欄拝見しました。

> Findメソッドってのがあるんですね。知りませんでした。

そんな上等なものじゃなくて、普通にExcelの一般機能としての
[検索(Ctrl+F)]をＶＢＡから命令しているだけのことで、
Excelの[検索]で見つけられないものは、
Findメソッドでも全く同じ理由で見つけられません。

> 早速ためしてみたんですが、P=Target.Offset(,1).valueのところでマクロがとまってしまいました。

そこで止まるということは、ほぼ、kensaku値が見つかっていない、
ということで、色々、これまでに挙げていた前提について再確認した方が良さそうです。

> kensaku値は必ずあるはずなんですが・・・。

そう言われても、悲しいかな、こちらでは確認しようがありませんです。

以下、確認した方がいいこと。
例えば、前スレと今回とでは、Sheet2とSheet3が入れ替わっていますよね。
その他にも細かいことが変わってたりするので、
「どのシートの」「どのセル」という点をもう一度、そちらで整理してください。
念の為ですが、Excelの数式で参照したセルは、移動しても数式の方で追跡して
自動的に修正してくれるものですが、ＶＢＡマクロにはそのような機能はありませんので、
セルやシートを移動させたなら、記述を手作業で書き換える必要があります。

検索する範囲は　【Sheet2】　【A1:A30】
　　Set M4 = Sheets("Sheet2").Range("A1:A30")
【Sheet1】　で最下行位置を採るのは、【A列】
　　L = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
【Sheet1】　Kensaku値を採るのは、【２行め】から【最下行】
　　For Z = 2 To L
【Sheet1】　Kensaku値を採るのは、【Ｃ列】
　　　　Kensaku = Sheets("Sheet1").Cells(Z, 3).Value
　　　　Set Target = M4.Find(What:=Kensaku, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, MatchByte:=False)
【Sheet2】　見つかったセルの【一つ右＝Ｂ列】から、個別データの数（＝コピーする行数）を採る
　　　　P = Target.Offset(, 1).Value

差し当たり、現在発生しているエラーの原因になりそうなのは、
上記【】でマークした、５行１１点の指定間違い、です。
例えば、
　　For Z = 2 To L
２行めからデータがある（というご提示のコードに書かれている条件）
という前提がもし違っていて、実は２行めはタイトルだったり、
データ以外のものをkensaku値に指定してしまっている為に
見つけられず、エラーになる、とか、

ＰＣは融通利かないですから、ちょっとしたことなどと侮らずに、
ひとつひとつの指定について確かめてください。

因みに私が提示したものは、Kensaku値が見つかる度に、
ひとつのKensaku値に対応した処理を終えてから次の検索に進むように
なっています。
もし、エラーで止まった場合、どこまで処理できているのか、
確認すれば、どの検索値でエラーになっているのか特定できる筈です。
例えば、１件も処理されていないのであれば、
【Sheet1】の【Ｃ２】セルが検索で見つかっていない、とか、
【Sheet1】の【Ｃ５】セルのKensaku値まで処理が済んでいたなら、
【Sheet1】の【Ｃ６】セルが検索で見つかっていない、とか、
順番を確かめることで、原因は特定し易くなります。

もうひとつ念の為質問の前提についての確認ですが、
検索で付き合せる、【Sheet1】【Ｃ列】、【Sheet2】【A1:A30】
の範囲にある値は、
"1A" , "2I" , 等の文字列値で間違いないですか？
前スレでも触れましたが、この値の種類が、文字列でない場合は、
そのデータの値の型、や、表示形式など、細かく見てあげないとなりません。
これも前提が違えばヒットしないケースがあります。
この場合でも、上記のように見つからないKensaku値を特定できれば、
実際にExcelの[検索]で確認することも出来ますから、
ご自分で確かめるようにしてください。

考えられる特殊なケースとしては、
例えば、
"1A "をKensaku値にしている場合、"1A"は見つかりません。
これ↑よく見ると半角スペースが混じっています。
シートを眺めている限りでは同じに見えるけれど、実際の値は違う、
という場合もあるかも知れません。
これもExcelの[検索]で確認できますね。

とにかく、検索に失敗したKensaku値を、
実際にExcelで[検索]してみましょう。

他、今回の前提とは矛盾が出るので、可能性からは除外出来ると信じていますが、
[セルの結合]を適用した範囲が検索に関わっている場合とか、
検索で扱う範囲に空白セルがあるとか、
このような非常に特殊なケースでは、エラーになる場合もあります。
今回は関係ないでしょうけれど、、、。

以上、今、そちらで出来ること、を書いてみました。
どんなコードを書いたって、それを日常的にメンテ管理するのは、ご本人です。
こちらから手出しできるものではありません。
まだデバッグのやり方も解らなくて、
コードを提供されても使いこなすことが難しいんだと思いますが、
なんとか、ご自分で出来るように工夫しないと、これから使い続けるのも難しくなります。
皆がやっていることですし、大変でしょうけれど頑張って修正してみてください。

以上です。

お礼

ありがとうございます。早速、明日チェックしてみます。
おっしゃる通りですね。分からないことを質問するのと、何もかも委ねてしまうのは違いますよね。ちょっと甘えてました。頑張ってみます。

回答No.1

real beatin（@realbeatin）

こんにちは。

元スレで回答した者です。
「エクセルＶＢＡマクロの質問です。」
http://okwave.jp/qa/q8928577.html

やはり、VLOOKUP関数には不向きな課題でした。
やろうと思えばLOOKUP関数で何千回計算させるとか、
Match関数とINDEX関数を組み合わせるとか、非常に複雑になってしまいます。
なので、実質の加筆２行だけで済むように、Findメソッドを使った例で
お応えします。
　Sheet1のＣ列をループして、kensaku 値を採り、
　　Sheet2のＡ列でマッチしたセルを取得して、
　　　その一つ右のセルの値が、元コードの P （VLOOKUP関数で求めていたもの）
　　　　P の値分の行数だけ、Sheet1のＡ：Ｃ列をSheet3にコピペして、
　　　　Sheet2のＡ列でマッチしたセルの２列（３、４、、、列）右のセルが、
　　　　Sheet3のＤ列下方向に出力する値、
という風になります。
この場合もkensaku 値が見つからなければエラーになります。

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Sub Re8929833a_()
Dim M4 As Range
Dim Target As Range
Dim P As Variant
Dim Kensaku As String
Dim L As Long
Dim PRow As Long
Dim i As Long
Dim Z As Long

　　Set M4 = Sheets("Sheet2").Range("A1:A30")
　　L = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row　'

　　For Z = 2 To L
　　　　Kensaku = Sheets("Sheet1").Cells(Z, 3).Value
　　　　Set Target = M4.Find(What:=Kensaku, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, MatchByte:=False)
　　　　P = Target.Offset(, 1).Value
　　　　PRow = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　Sheets("Sheet1").Cells(Z, "A").Resize(, 3).Copy Sheets("Sheet3").Cells(PRow + 1, "A").Resize(P)
　　　　　　For i = 1 To P
　　　　　　　　Sheets("Sheet3").Cells(PRow + i, "D").Value = Target.Offset(, 1 + i).Value
　　　　　　Next i
　　Next Z

　　Application.ScreenUpdating = True
End Sub

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

お礼

早速お返事いただきありがとうございました。昨日は、バタバタしてましてお礼が遅くなりすみません。Findメソッドってのがあるんですね。知りませんでした。早速ためしてみたんですが、P=Target.Offset(,1).valueのところでマクロがとまってしまいました。kensaku値は必ずあるはずなんですが・・・。