Excel_VBAでVlookup関数を使って位置を取得する方法

以前、下の記事でADDRESS関数 / MATCH関数 / INDIRECT関数を使って、コピーの開始位置と終了位置を自動取得するという内容を紹介しました。

ExcelコマンドBOXでワンランク上のマクロ作成＋他のソフトにコピーまでしてみる

今回は指定した日付の行を探し出し、その行に必要事項をコピーしていきたい。

というアクションが必要になったのでご紹介します。

※あまりスマートなやり方ではないと思うので、ご了承ください！！

この記事が参考になる方（出てくる内容）

VBAで指定したワードの行や列に対し、アクションをしていきたい方
VBAでVLookup関数を使いたい方
VBAのコマンドボックスを使いたい方
Excelで振り返り日記をつけたい方

このコードを作ろうと思ったきっかけが、その日の振り返りをMindMapに書いていたのですが、後で検索しにくい！！って思ったので、集計と言えばExcelだし振り返り日記を作ってみよう。って感じです。

目次～Excel_VBAでVlookup関数を使って位置を取得する方法～

STEP1

振り返り日記のやりたい事イメージ設計

■ 日付と振り返り一覧のシートが欲しい⇒検索用
■ その日ごとに整理したい⇒日付ごとシートをつくる
■ 自動でシートを作って、日付シートの内容は一覧シートに1クリックで貼り付けたい

取り急ぎの完成形

STEP2

日付シートを作成するための、コマンドBOXを設定していきます。

コマンドボックスの作成方法はこちらを見てください。

ExcelコマンドBOXでワンランク上のマクロ作成＋他のソフトにコピーまでしてみる

今回のファイルのコードと解説です。

「CommandButton1」を「Click」した時のアクションを決めるものです。

コマンドBOXの設定

Private Sub CommandButton1_Click()
'①変数の定義と値付け Dim Textbx1 As String Textbx1 = Me.TextBox1.Text
'②コマンドボタンを押したらBOXが消える設定をする Unload UserForm1
'③シートをコピー Sheets("原紙").Select Sheets("原紙").Copy After:=Sheets(2)
'④テキストボックスで入力した値をシート名にする Sheets("原紙 (2)").Select Sheets("原紙 (2)").Name = Textbx1 Range("C2").Select Calculate
End Sub

==解説==

①Textbx1という変数＝テキストボックスの値とする
②Unload UserForm1でクリック後にコマンドボックスを閉じる
③日付シートの元になる『原紙』シートをコピー
④コピーしたシート名をTextbx1(テキストボックスの値)にする

STEP3

一覧表『Summary』シートのボタンを押すと、コマンドボックス（UserForm1）が呼び出されるようにする。

コマンドBOXの起動

Sub boxup()
'ユーザーフォーム（BOX）の召喚 UserForm1.Show
End Sub

boxupというマクロをボタンに登録します。

[ad05]

STEP4

日付シートの内容をSummaryにコピーするコード

後で別の日付を編集した時に、一覧表の該当日付を見つけて反映する必要がある

ここがこの記事の一番のポイントで、Vlookup関数（VBAではWorksheetFunction.VLookup）を使います。

Summaryシートへの反映

Sub Hanei()
'⑤変数の定義＋シート名を変数に定義 Dim Dy1 As String Dy1 = ActiveSheet.Name
'⑥Summaryシートの対象日付欄を探す Dim Ad1 As String Dim ScRange As Range Set ScRange = Worksheets("Summary").Range("B4:C1000") Ad1 = WorksheetFunction.VLookup(Dy1, ScRange, 2, False)
' Ad1 = Application.Max(ScRange)　'動作確認用 Sheets("Summary").Select
' Range("A1").Value = Ad1 '動作確認用
'⑦そのセルに移動し、Good/Bad個数を反映 Range(Ad1).Select ActiveCell.Offset(0, 1).Activate '右のセルに移動 ActiveCell.Value = Worksheets(Dy1).Range("C19") ActiveCell.Offset(0, 1).Activate '右のセルに移動 ActiveCell.Value = Worksheets(Dy1).Range("C20") ActiveCell.Offset(0, 1).Activate '右のセルに移動
'⑧リンク作成 Dim Ad2 As String Dim Ad3 As String Ad2 = "'" & Dy1 & "'!A1" Ad3 = Dy1 ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _ Ad2, TextToDisplay:=Ad3 ActiveCell.Offset(0, 1).Activate '右のセルに移動
'⑨振り返り「値」コピー Worksheets(Dy1).Range("C23:AP23").Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWorkbook.Save
End Sub

==解説==

⑤Dy1という変数＝現シート(編集している日付シート)のシート名とする

⑥Ad1という変数（文字列）とScRangeという変数（範囲）を規定する
– ScRangeは「Summary」シートの日付列（B列）とセルのアドレスを記した（C列）とする。
– Ad1は、Vlookup関数を使い｛ScRange範囲からDy1(=日付シート名)を探し、2列目（=C列＝セルのアドレス）の値とする　

⑦セルAd1（＝対象の行のC列）を選択し、ActiveCell.Offsetを使って右に移動しつつ、必要事項を貼っていく

ポイント

左に移動する時は(0,-1)、下に移動する時は(1,0)、上に移動する時は(-1,0)

2マス移動する時は数字を2にする

⑧一覧表に日付シートのリンクを貼る

⑨振り返り表の値をコピーし、 Selection.PasteSpecial Paste:=xlPasteValues で「値のみコピー」し、保存する
– 日付シートを関数表示すると、表の値を横一行に反映する関数を挟んでいるのが分かります。（C23～AP23）

その他の貼り付けスタイル

xlPasteAll	すべてを貼り付け
xlPasteValues	値を貼り付け
xlPasteFormulas	数式を貼り付け
xlPasteValuesAndNumberFormats	値と数値の書式を貼り付け
xlPasteFormats	書式を貼り付け
xlPasteFormulasAndNumberFormats	数式と数値の書式を貼り付け
xlPasteComments	コメントを貼り付け
xlPasteValidation	入力規則を貼り付け
xlPasteAllExceptBorders	輪郭以外のすべてを貼り付け

以上ですー。

最後まで見ていただき、ありがとうございました。