エクセル関数をVBAでやりたい

質問

IFERROR(INDEX(***,MATCH(***)),"")この式を下記マクロに組み込むことは、可能でしょうか？

Sub　Macro1()
'
Dim　line3　As　Integer
Dim　line5　As　Integer

line5　=　2　　'初期値を２行目に設定してます

Do　While　Worksheets("Sheet5").Cells(line5,　1).Value　>　0

'sheet5の通し番号をsheet3のH列から検索して、その行数をline3に代入する。
　　line3　=　Worksheets("Sheet3").Range("H:H").Find(what:=Worksheets("Sheet5").Cells(line5,　8)）.Row

'A,B列内容のコピー
　　Worksheets("Sheet5").Range("A"　&　line5,　"B"　&　line5).Copy　Worksheets("Sheet3").Cells(line3,　1)
'D～G列内容のコピー
　　Worksheets("Sheet5").Range("D"　&　line5,　"G"　&　line5).Copy　Worksheets("Sheet3").Cells(line3,　4)
　　line5　=　line5　+　1　　　　'次の行へ

Loop

　　（　http://soudan1.biglobe.ne.jp/qa8921867.html　）

回答No.4

real beatin（@realbeatin） · ベストアンサー

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

> 最初の式はシート3のＩ8セルから90列　200行　IFERROR(INDEX($G9,MATCH(I$8,$F9,0)),"")
> 関数を入れてます。
「Ｉ8セル」は「Ｉ９セル」のことでしょうね（循環参照になる筈ないので）。
　　=IFERROR(INDEX($G9,MATCH(I$8,$F9,0)),"")
という数式だけでは、意図が伝わりませんが、
たぶん、
　　=IF($F9=I$8,$G9,"")　
のような数式での処理を意図している■と判断しました。
　Sheet3　
　　Ｆ列[今回]日付
　　Ｉ８から右９０列[過去の数量記録欄]の日付
　が一致した場合だけ
　　一致した列 and 該当行位置に、Ｇ列[数量]を出力
という処理を、ご提示のマクロに追加したい■と。

シートデータ（表）のイメージが判りましたので、
こちらでは、説明された通りのシート構成を作成してテストしました。

解らないのは、
　Sheet3 の見出しが、１行めと８行めの２ヶ所あるのは何故か？■
　Sheet3 常に９行め以下を処理すればいいのか、それとも、明示できる条件があるのか？■
疑問は残ったままですが、指示通り、８行めを見出し行、９列めからがデータ
という前提で書きました。
もし、違っている場合は、
　　「.... 中見出し行位置　を★★指定」
と書かれた行の数値指定' = 8 'を書き換えてください。

結構手数が要る課題なので、もし、これで不足があっても対応には時間掛かると思っていてください。
因みに、過去の質問を読み込んでも、セルの位置や細かい具体的条件が変わっているようなので
状況の把握には役立ちませんでした。
マクロ（ＶＢＡ）では、曖昧な指示をすることが出来ませんので、
位置情報やシートレイアウトについては、こちらも確実なものを求めるしかありません。
補足を戴く場合は、貴方が実際に目にしているものすべてが、
こちらには見えていないことを意識して、何を伝えれば解決に繋がるかだけを考えて、
十分な情報を用意し、短い手数で解決できるようお互いにつとめましょう。
こちらからは４点の確認事項■を提示していますのでチェックしてください。
現在のマクロを以下のマクロに（一時的に）差し替えて
動作を確かめて下さい。
こちらが想定している通りのシートデザインであれば、
こちらでは動作確認してあります。
そちらでも実際に試してみて下さい。

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub Macro1()　'　Re8927109rh
Dim tmp
Dim rng As Range, rng5SrNum As Range
Dim nTopRow As Long, nBtmRow As Long, nPDate1 As Long, nPDateL As Long
Dim i As Long, j As Long
　　Set rng5SrNum = Sheets("Sheet5").Range("H:H")　'　Sheet5　Ｈ列[通しＮo]　列（Ｈ？）を★指定
　　With Sheets("Sheet3")
'　　　　Set rng = .Range("A:A").Find(What:="月", After:=.Cells(Rows.Count, "A"), _
'　　　　　　　　　　　　LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlPrevious)
'　　　　If rng Is Nothing Then MsgBox "Ａ列に見出し「月」が見当たりません", vbExclamation: Exit Sub
'　　　　nTopRow = rng.Row
　　　　nTopRow = 8　'　Sheet3　中見出し行位置　を★★指定
　　　　nBtmRow = .Cells(Rows.Count, "H").End(xlUp).Row　'　Sheet3　データ最下行位置　列（Ｈ？）を★指定

　　　　nPDate1 = 9　'　Sheet3　[過去の数量記録欄]の先頭列位置　を★指定
　　　　nPDateL = .Cells(nTopRow, "I").End(xlToRight).Column　'　Sheet3　[過去の数量記録欄]の右端列位置　列（Ｉ？）を★指定

　　　　Application.ScreenUpdating = False　'　描画更新を一時停止
　　　　For i = nTopRow + 1 To nBtmRow　'　Sheet3　中見出し行位置　から　データ最下行位置　まで行をループ
　　　　' ' Sheet3　Ｈ列[通しＮo]をループして　Sheet5　Ｈ列[通しＮo]の一致したセルを取得
　　　　　　Set rng = rng5SrNum.Find(What:=.Cells(i, "H"), _
　　　　　　　　　　　　LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)　'　列（Ｈ？）を★指定
　　　　　　If Not rng Is Nothing Then　'　万が一を考えて　見つかった時だけ以下の処理
　　　　　　　　rng.EntireRow.Resize(, 2).Copy Destination:=.Cells(i, "A")　'　Sheet5からSheet3　A:Bをコピペ　列（Ａ？）を★指定
　　　　　　　　rng.EntireRow.Resize(, 4).Offset(, 3).Copy Destination:=.Cells(i, "D")　'　Sheet5からSheet3　D:Gをコピペ　列（.Offset(, 3)？Ｄ？）を★指定
　　　　　　　　tmp = .Cells(i, "F").Value　'　Sheet3　Ｆ列[今回]日付を変数に格納　列（Ｆ？）を★指定
　　　　　　　　For j = nPDate1 To nPDateL　'　Sheet3　[過去の数量記録欄]の　先頭列位置　から　右端列位置　までループ
　　　　　　　　　　If .Cells(nTopRow, j).Value = tmp Then　'　[今回]日付　と一致する列　を見つけたら
　　　　　　　　　　　　.Cells(i, j) = .Cells(i, "G")　'　Sheet3　[過去の数量記録欄]　該当行　一致した列　にＧ列[数量]を出力　列（Ｇ？）を★指定
　　　　　　　　　　　　Exit For　'　それ以上　[過去の数量記録欄]　を探す必要がないので　ループを抜ける
　　　　　　　　　　End If
　　　　　　　　Next j
　　　　　　' ' 万が一　[今回]日付　が　[過去の数量記録欄]　で見つからない場合　メッセージ
　　　　　　　　If j > nPDateL Then MsgBox "今回日付：" & .Cells(i, "F") & "該当日付欄未設定", vbExclamation　'　列（Ｆ？）を★指定
　　　　　　End If
　　　　Next i
　　End With
　　Application.ScreenUpdating = True　'　コピー処理をループした後に描画エラーを防ぐ為の記述
End Sub
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

お礼

説明不足にもかかわらず　ご理解いただき感謝いたします。

思い道理の仕上がりに感激しました。

皆様は、どのようにＶＢＡを学ばれたのでしょうか？

では、またの質問の時も　宜しくお願い致します。

回答No.3

real beatin（@realbeatin）

こんにちは。お邪魔します。

> IFERROR(INDEX(***,MATCH(***)),"")この式を下記マクロに組み込むことは、可能でしょうか？

可能です。

　「Sheet3のH列の値を　Sheet5のH列から探し」
　　（つまりご提示のマクロと比べて「探す」ことの「主従」を逆にします）
　「見つかれば、Sheet5のH列と同じ行の値をそれぞれ転記」
　「見つからない場合、指定の値で項目を埋める」
ということがなさりたい、という理解でいます。
例えば、Sheet3は100行め、Sheet5は90行め、が最下行だとすると、
　　Sheet3のA2:B100,D2:G100に
　　=IFERROR(INDEX(Sheet5!A$2:A$90,MATCH($H2,Sheet5!$H$2:$H$90,0),1),"-")
のような数式を一括で設定した結果として、
もし、Sheet5のH列で見つからない場合は、"-"という値を返す。
ということを、マクロ（VBA）で実現してみます。
ニーズへの理解に若干自信がないので、３例挙げますが、
結果はどれも（データ内容については）同じです。

１■なるべく、元のコードを残す書き方。
（Sheet3での行位置をループするので、For Nextで書くことになります。）
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub Re8927109a()
Dim line5 As Variant
Dim i As Long
　　With Sheets("Sheet3")
　　　　For i = 2 To .Cells(Rows.Count, "H").End(xlUp).Row
　　　　　　On Error Resume Next
　　　　　　' ' MATCH関数で見つかる行位置
　　　　　　line5 = WorksheetFunction.Match(.Cells(i, 8), Worksheets("Sheet5").Range("H:H"), 0)
　　　　　　If Err.Number <> 0 Then
　　　　　　　　On Error GoTo 0
　　　　　　　　.Range("(A:B,D:G) " & i & ":" & i).Value = "-"　'　Sheet5には記載がない場合
　　　　　　Else
　　　　　　　　On Error GoTo 0
　　　　　　　　Worksheets("Sheet5").Range("A" & line5, "B" & line5).Copy .Cells(i, 1)　'　A,B列内容のコピー
　　　　　　　　Worksheets("Sheet5").Range("D" & line5, "G" & line5).Copy .Cells(i, 4)　'　D～G列内容のコピー
　　　　　　End If
　　　　Next i
　　End With
　　Application.ScreenUpdating = True　'　コピー処理をループした後に描画エラーを防ぐ為の記述
End Sub
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

２■ほぼ変わらない内容だけど、コピペすると煩わしいので
値だけを転写します（書式等はコピーしません）。
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub Re8927109b()
Dim line5 As Variant
Dim i As Long
　　With Sheets("Sheet3")
　　　　For i = 2 To .Cells(Rows.Count, "H").End(xlUp).Row
　　　　　　On Error Resume Next
　　　　　　' ' MATCH関数で見つかる行位置
　　　　　　line5 = WorksheetFunction.Match(.Cells(i, 8), Worksheets("Sheet5").Range("H:H"), 0)
　　　　　　If Err.Number <> 0 Then
　　　　　　　　On Error GoTo 0
　　　　　　　　.Range("(A:B,D:G) " & i & ":" & i).Value = "-"　'　Sheet5には記載がない場合
　　　　　　Else
　　　　　　　　On Error GoTo 0
　　　　　　　　.Cells(i, "A").Resize(, 2).Value = Worksheets("Sheet5").Cells(line5, "A").Resize(, 2).Value '　A,B列の値をトレース
　　　　　　　　.Cells(i, "D").Resize(, 4).Value = Worksheets("Sheet5").Cells(line5, "D").Resize(, 4).Value　 '　D～G列の値をトレース
　　　　　　End If
　　　　Next i
　　End With
End Sub
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

３■「IFERROR(INDEX(***,MATCH(***)),"")この式を下記マクロに組み込む」
というオーダーに素直に答えた場合の例（書式等はコピーしません）。
現代の Excel VBA としては、広く知られた手法でもあります。
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub Re8927109f()
Const 数式 = "=IFERROR(INDEX(Sheet5!A$2:A$#,MATCH($H2,Sheet5!$H$2:$H$#,0),1),""-"")"
Dim sFml As String
Dim nBtmRow3 As Long
Dim nBtmRow5 As Long
　　nBtmRow5 = Sheets("Sheet3").Cells(Rows.Count, "H").End(xlUp).Row　'　Sheet5の最下行位置
　　sFml = Replace(数式, "#", nBtmRow5)　'　Sheet5の最下行位置を数式に反映
　　With Sheets("Sheet3")
　　　　nBtmRow3 = .Cells(Rows.Count, "H").End(xlUp).Row　'　Sheet3の最下行位置
　　　　With .Range("(A:B,D:G) 2:" & nBtmRow3)　'　Sheet3の数式を適用する範囲を一纏めに
　　　　　　.Formula = sFml　'　数式を設定
　　　　　　.Areas(1).Value = .Areas(1).Value　'　数式の計算結果を固定値（定数）化（ブロック１）
　　　　　　.Areas(2).Value = .Areas(2).Value　'　数式の計算結果を固定値（定数）化（ブロック２）
　　　　End With
　　End With
End Sub
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

補足

早速のご回答有難うございます。

説明不足ですね。申し訳ありません。文章にするのがにがてなもので、

最初の式はシート3のＩ8セルから90列　200行　IFERROR(INDEX($G9,MATCH(I$8,$F9,0)),"")
関数を入れてます。

Sub　Macro1()の処理実行をすると上記関数も実行出来ればと思ってるのですが。

　　　　　　　　　　　ＳＨＥＥＴ3

　　　Ａ　　　Ｂ　　　　Ｃ　　　　Ｄ　　　　　Ｅ　　　Ｆ　　　　Ｇ　　　　Ｈ　　　Ｉ　　　Ｊ
1　　月　　　日　　　　　
2　　3　　　　8　　　
・　　　　　　　　　シート5に　　　　シート5からシート3
・　　　　　　　　　抽出ボタン　　　　　転記ボタン
・

8　　月　　　日　　　得意先　　前回　　　　数量　　今回　　数量　　　　　　2/5　　2/6　　2/7
9　　3　　　7　　　　Ａ商事　　1/7　　　　　　　3　　2/5　　　　　2　　　　1　　　　2
10 　3　　　7　　　　Ｂ商事　　1/5　　　　　　　2　　2/6　　　　　1　　　　2　　　　　　　　

Ｉ列以降は、保存(3か月ほど)したいのです。
ＶＢＡ　なら記録を残せると以前、解答をいただいてます。

転記ボタン　クリックでＪ10セルにＧ10の　1を転記したいのです。

http://soudan1.biglobe.ne.jp/qa8918740.html

いろいろな方法をご提示いただき、誠に恐縮でございますが、この説明でご理解頂けたでしょうか？
どうか宜しくお願い致します。

回答No.2

imogasi

質問に補足をしてはどうかと思う、理由は
>IFERROR(INDEX(***,MATCH(***)),"")
とは何をしたいのか。
IFERROR関数は、存在し無いのでは？
ＭＡＴＣＨ関数で引数に***を使っているのは何。どうしたいのか？
＊＊＊は一般化したいのか。しかし我流では。
ＩＮＤＥＸ関数も、***を使っているのは同じ疑問有り。
ーー
ＶＢＡやプログラムに詳しい人でも、関数を複雑に組み合わせたものなど、何をやっているか、解釈しにくい場合がある。過去の回答状況から、両方詳しい人は少ないだろう。
プログラムに詳しい人（プロ）でも、エクセルや、エクセルＶＢＡにくわしくない人もいた。本格的にプログラムをやる人は、普通にエクセルは使えても、エクセルなんて、という人も見た。
ーーー
だから
ＶＢＡのことを聞くなら、簡単な実例（セル範囲とデータ）を自作して、質問に書いて、何をしたいか１歩ずつ、文章で書いて説明すべきだ
（例）Ｈ列から値ＸＸを探して、見つかったら、その行のＹＹをＺＺセルに代入する、とか
ーーー
質問者は本件が判ればそれでよいと、お考えかもしれないが、ＯＫＷＡＶＥにこの分野で登録するとみんなに質問が回され、質問を読まされる。
また数年後にも、Ｇｏｏｇｌｅで関連したキーワードで照会すると本質問と回答が出てくるのだ。
第１義的には私的だが公的な面もある。だから質問は判りやすく書いてほしい。
ーーーー
＞エクセル関数をＶＢＡでやりたい
をこの行だけ文字通り解釈すればApplication.WorksheetFunctionを使えば仕舞というケースもある。
http://www.moug.net/tech/exvba/0100035.html
たとえばＭａｔｃｈ関数は
Ｃ１：Ｃ５にデータを入れて
ss
a
df
ss
b
Sub test02()
r = Application.WorksheetFunction.Match("a", Range("c1:C5"), 0)
MsgBox r
End Sub
を実行して２が返る、のように見つかった行番号がわかる。
しかし第２、第３の該当は見つけてくれないので、工夫がいる。たとえば範囲を狭めて再実行するとか。
しかしあまり過去の回答でもこの方式を見かけない。
Ｆｉｎｄも第２、第３の該当を見つけることや、探索繰り返しの終わりを察知して処理を終わるのは、初心者にはむつかしいように思う。
この質問の主眼点は検索ですか？
ーー
本質問はそういう単純な例ではなさそうなので、質問者が書けるＶＢＡコードは参考に付記して、回答者に優れたロジックやコードを公募して、良いと思えば勉強したらよいと思う。
ーー
どうしても質問者のコードの形をこだわる（残す）なら、
文章で、コード行の直前（上）に、したいことを文章で書き込んで（コメント）、わからないところ（行）だけ文章だけにして質問するとかもある。
ーー
私の好み。
ＶＢＡではＣｏｐｙ貼り付けよりも、シート名・セル番地＝シート名・セル番地と、代入方式を使うほうが
わかりやすいのでは？
書式まで持っていきたい場合は、そう多くないから。

回答No.1

watabe007

>IFERROR(INDEX(***,MATCH(***)),"")この式を下記・・・
Findで見つからなかった時の対策なら別案ですが参考に
Sub Test()
　Dim i As Long
　Dim myRng As Variant

　With Worksheets("Sheet5")
　　'Sheet5の２行目から最終行までループ
　　For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
　　　'Sheet5のCells(i, 8)の値をSheet3のH列から完全一致で検索
　　　Set myRng = Worksheets("Sheet3").Range("H:H").Find(What:=.Cells(i, 8).Value, LookIn:=xlValues, LookAt:=xlWhole)
　　　If myRng Is Nothing Then
　　　　'見つからない時の処理
　　　　'MsgBox i & "行目の" & .Cells(i, 8).Value & "が見つかりません", 16
　　　Else
　　　　'見つかればSheet3にコピー
　　　　.Cells(i, "A").Resize(, 2).Copy Worksheets("Sheet3").Cells(myRng.Row, 1)
　　　　.Cells(i, "D").Resize(, 4).Copy Worksheets("Sheet3").Cells(myRng.Row, 4)
　　　End If
　　Next i
　End With
End Sub