１. 本マクロの概要
└１-１.このマクロで何ができるか
└１-２.マクロ起動時の画面遷移
２. ソースコード掲載
３. ソースコード概要説明
└ユーザー改造可能箇所
１-１. このマクロで何ができるか
このマクロは、Excelの帳簿からデータを転記することを想定しています。
ユーザーが指定したセルから下方向に、１列分のデータを走査します。抽出対象は、ユーザーが指定したセルに記載されている文字列です。抽出対象のセルがある行のデータを新規シート転記します。
ユーザーに求める操作は以下の通りです。
■セルを指定
・指定したセルの列を下方向に走査します
・指定したセルに記載されている文字列を抽出対象とし転記操作を実施します
具体的な動作は、１-２.マクロ起動時の画面遷移で確認願います。
１-２. マクロ起動時の画面遷移
マクロ起動時の画面遷移は主に２つとなります。
※注意！
選択したセルに記載の文字列を名前にして、新規シートを作成します。
以下の点に注意してください。
■マクロを呼び出した時に、抽出したいデータが記載してあるワークシートにアクティブセルが置いてあるか。
■同じ名前のシートが作成されていないか。
「データ抽出(“抽出文字列”)」
■抽出文字列に“ . (ピリオド)”や“ /(スラッシュ) ”が含まれていないか。
シート名に含めることができない文字が抽出文字列に含まれている場合、エラーが発生します。上記文字を拭くものを抽出対象に抽出したい場合は、マクロを改造して作成するシート名を変更してください。
２. ソースコード掲載
マクロのソースコードは、以下の通りです。マクロの登録方法は、本ブログ内で紹介しておりますので、本ブログの「３.ExcelにおけるVBAマクロの登録と利用方法」からご確認ください。
Sub 帳簿から自分の行のみを抽出()
Dim rSelectedRange As Range 'ユーザーが選択するセル
Dim sScanningTarget As String '走査対象の文字列
Dim sActiveWorksheetName As String '走査対象のデータが記載されているワークシート名
Dim sDeleteWorksheetName As String '削除するワークシート名
Dim iExtractCountor As Integer '走査回数を保持するカウンター
Dim rExtractBaseCell As Range '抽出の基点となるセル
Dim iColumnBlankCountor As Integer '行方向に連続してNULLセルを読み込んだ回数のカウンター
Dim iColumnCountor As Integer '行方向にセルを読み込んだ回数のカウンター
Dim iNumberOfRightEdge As Integer '行方向に抽出する右端の列番号
Dim iRowNum As Integer '転記先シートの転記行番号
Dim bCheckValue As Boolean 'アクティブセルが抽出対象セルなのかを示すフラグ
Dim rCopy As Range '転記走査用変数
Dim rTarget As Range '転記操作用変数
On Error Resume Next
'InputBoxを表示して、ユーザーに、抽出対象の文字列が記載してあり、かつ、走査対象列にあるセルを選択してもらう
Set rSelectedRange = Application.InputBox("抽出する氏名が記載されたセルを1つだけ選択してください。" & vbLf & _
"選択されたセルから下方向に走査します。" & vbLf & _
"操作を中断する場合は【キャンセル】をクリックしてください", _
Type:=8, _
Title:="走査対象の文字列が入力されているセルを選択")
'「キャンセル」がクリックされた場合は処理終了
If rSelectedRange Is Nothing Then Exit Sub
On Error GoTo 0
'選択されたセルから走査対象の文字列を取得
sScanningTarget = rSelectedRange.Value
'選択されたセルが空白だった場合、マクロを終了する
If sScanningTarget = "" Then _
'メッセージボックス表示
MsgBox ("エラー発生。" & vbLf & _
"エラー内容：選択したセルが空白セルであったため。")
'マクロ終了
Exit Sub
End If
'抽出対象のデータが記載されているワークシート名
sActiveWorksheetName = ActiveSheet.Name
'抽出データを転記するためのワークシートを追加し、追加したシートの名前を変更
Worksheets.Add After:=ActiveSheet, Count:=1
'シートの追加処理でエラーが発生した場合、"Catch:"以下の処理が走りマクロが終了します
On Error GoTo Catch
'抽出対象名でシートを追加
ActiveSheet.Name = "データ抽出(" & sScanningTarget & ")"
Catch:
If Err.Number = 1004 Then
'Worksheets.Add After:=ActiveSheet, Count:=1処理で追加したシートの名前を取得
sDeleteWorksheetName = ActiveSheet.Name
'抽出データが記載してあるシートに移動
Worksheets(sActiveWorksheetName).Select
'「このシートを削除しますか？」の表示を一時的に非表示化
Application.DisplayAlerts = False
'Worksheets.Add After:=ActiveSheet, Count:=1処理で追加したシートを削除
Worksheets(sDeleteWorksheetName).Delete
'「このシートを削除しますか？」の表示を再度表示化
Application.DisplayAlerts = True
'メッセージボックス表示
MsgBox "エラー内容：抽出対象を転記するためのシートが既に作成されているため。" & vbLf & _
"対応依頼 ：既存のシートを削除してください→【シート名】データ抽出(" & sScanningTarget & ")" & vbLf & _
vbLf & _
"マクロを終了します", _
Title:="エラー発生!!"
'マクロ終了
Exit Sub
End If
On Error GoTo 0
'データが記載されているワークシートを選択
Worksheets(sActiveWorksheetName).Select
'抽出の基点となるセルを、ユーザーが指定したセルに設定
Set rExtractBaseCell = rSelectedRange
'列方向の空白カウンターを0リセット
iExtractCountor = 0
'転記先シートの転記始めは2行目に設定
iRowNum = 2
'列列方向で5回連続で空白セルを読み込むか、行方向に50回連続して空白セルを読み込むまで走査
Do While iExtractCountor >= 0
'行方向の走査カウンターをリセット
iColumnBlankCountor = 0
'抽出対象の右端列番号を設定
iNumberOfRightEdge = rExtractBaseCell.Column
'アクティブセルが抽出対象か否かの判定フラグを倒す
bCheckValue = False
'列方向に走査
'アクティブセルが抽出対象のセルになるまで走査を継続
Do While bCheckValue = False
'アクティブセルが抽出対象の文字列が記載されているセルの場合
If rExtractBaseCell.Value = sScanningTarget Then _
'判定フラグを立てる
bCheckValue = True
'アクティブセルが空白の場合
ElseIf rExtractBaseCell.Value = "" Then _
'連続して空白を読み込んだカウンターをインクリメント
iColumnBlankCountor = iColumnBlankCountor + 1
'5回以上連続して空白セルを走査した場合
If iColumnBlankCountor >= 5 Then _
'データの抽出が完了したことをユーザーに伝えるメッセージボックスを表示
MsgBox ("抽出完了!" & vbLf & _
"作成したシート名：データ抽出(" & sScanningTarget & ")" & vbLf & _
"抽出したデータ数：" & iExtractCountor & "行分")
'マクロを終了させる
Exit Sub
'空白セルの連続走査が5回未満の場合
Else
'走査セルの行番号を1行下に設定
Set rExtractBaseCell = rExtractBaseCell.Offset(1, 0)
End If
'アクティブセルに抽出対象の文字列が記載されていない、かつ、空白ではない場合
Else
'走査セルの行番号を1行下に設定
Set rExtractBaseCell = rExtractBaseCell.Offset(1, 0)
'連続して空白を読み込んだカウンターを0リセット
iColumnBlankCountor = 0
End If
Loop
'行方向に連続して空白を読み込んだカウンター
iColumnBlankCountor = 0
'行方向に読み込んだセル数カウンター
iColumnCountor = 0
'行方向に走査
'連続したNULLセルが3回続くまで走査し、データが記載されている右終端列番号を取得する
Do While iColumnBlankCountor < 3
On Error Resume Next
'アクティブセルが"NULL"か判定
If Cells(rExtractBaseCell.Row, iNumberOfRightEdge) = "" Then _
'行方向の、連続した空白カウンターをインクリメント
iColumnBlankCountor = iColumnBlankCountor + 1
Else
'連続していない場合は0リセット
iColumnBlankCountor = 0
End If
On Error GoTo 0
'行方向に読み込んだセルの個数をカウント
iColumnCountor = iColumnCountor + 1
'無限ループを避けるためのガード処理を実施
'行方向の読み取り上限：50個
If iColumnCountor >= 50 Then _
MsgBox ("通知：行方向に50個のセルを読み込んだため次の列走査に移行" & vbLf & _
"確認：通知を読んだらOKを押してください)")
'カウンターを操作して行方向の操作を終了
iColumnBlankCountor = 5
End If
'抽出を対象の右端列番号をインクリメント
iNumberOfRightEdge = iNumberOfRightEdge + 1
Loop
'転記先シートへ移動
Set rTarget = Worksheets("データ抽出(" & sScanningTarget & ")").Range("B" & iRowNum)
'行方向への走査が終わったので、データの転記を実施
'抽出対象の文字列が記載されているセルから、データが記載されている右終端の列番号までのセル範囲をコピー。新規シートにデータを転記。
For Each rCopy In Range(Cells(rExtractBaseCell.Row, rExtractBaseCell.Column), Cells(rExtractBaseCell.Row, iNumberOfRightEdge))
'転記先シートへデータを転記
rTarget.Value = rCopy.Value
'転記先の行番号は変えず、列を右方向に1つずらす
Set rTarget = rTarget.Offset(0, 1)
Next
'転記先行番号をインクリメント
iRowNum = iRowNum + 1
'抽出元データが記載されているシートへ移動
Worksheets(sActiveWorksheetName).Select
'列方向の抽出走査セルを1行下に移動させ、次の列方向走査に備える
Set rExtractBaseCell = rExtractBaseCell.Offset(1, 0)
'抽出実行カウンターをインクリメント
iExtractCountor = iExtractCountor + 1
Loop
End Sub
３. ソースコード概要説明
ソースコードの記載概要を、各パーツごとに説明します。
ユーザーに適宜改造してほしい箇所には、「ユーザー改造箇所」と明記いたします。
- 変数宣言
- 入力情報によるエラーを無視する
- ユーザーにセルの指定を促し、エラー入力の場合はマクロ終了
- ユーザーが選択したセルから「抽出対象文字列」取得.空白セルが選択されていた場合はマクロを終了
- データを転記するためのワークシート追加
└ユーザー改造箇所 - 転記ループ処理の開始
- 列方向への操作_抽出対象セルの検索
- 行方向に走査_データが記載されている右終端列番号を取得
- 行方向→列方向に走査したデータを転記
- 抽出データが記載されているシートへ戻り、次の検索へ
変数宣言
Dim rSelectedRange As Range 'ユーザーが選択するセル
Dim sScanningTarget As String '走査対象の文字列
Dim sActiveWorksheetName As String '走査対象のデータが記載されているワークシート名
Dim sDeleteWorksheetName As String '削除するワークシート名
Dim iExtractCountor As Integer '走査回数を保持するカウンター
Dim rExtractBaseCell As Range '抽出の基点となるセル
Dim iColumnBlankCountor As Integer '行方向に連続してNULLセルを読み込んだ回数のカウンター
Dim iColumnCountor As Integer '行方向にセルを読み込んだ回数のカウンター
Dim iNumberOfRightEdge As Integer '行方向に抽出する右端の列番号
Dim iRowNum As Integer '転記先シートの転記行番号
Dim bCheckValue As Boolean 'アクティブセルが抽出対象セルなのかを示すフラグ
Dim rCopy As Range '転記走査用変数
Dim rTarget As Range '転記操作用変数マクロで使用する変数を宣言します。各変数名の頭についている文字は、各変数のデータ型を示しています。
r：Range型 セル範囲などを扱います
s：String型 文字列を扱います
i：Integer型 数値を扱います
b：Boolean型 ０ or １のフラグ情報を扱います
入力情報によるエラーを無視する
On Error Resume Next
...
On Error GoTo 0ユーザーの入力情報により発生するエラーを、On Error Resume NextからOn Error GoTo 0の間では無視します。これを宣言することで、エラーが発生してマクロが止まる場合でも、マクロのソースコード画面(VBA画面)に飛ばされなくなります。
ユーザーにセルの指定を促し、
エラー入力の場合はマクロ終了
選択してもらう
Set rSelectedRange = Application.InputBox("抽出する氏名が記載されたセルを1つだけ選択してください。" & vbLf & _
"選択されたセルから下方向に走査します。" & vbLf & _
"操作を中断する場合は【キャンセル】をクリックてしてください", _
Type:=8, _
Title:="走査対象の文字列が入力されているセルを選択")
'「キャンセル」がクリックされた場合は処理終了
If rSelectedRange Is Nothing Then Exit Subユーザーからのセル指定を、Application.InputBox()メソッドにより入力フォームを表示させて促します。
メソッド内の“Type：８”の記述により、入力値はRange型(セル範囲)となります。
入力されたセル情報は、rSelectedRange変数に格納されます。
メソッドの初めの文章は、入力フォームに表示される文章です。自由に変えていただいて構いません。
& vbLf & _は、vbLfが入力フォーム文字列内の改行となります。 _(スペース アンダーバー)は、ソースコード内の改行です。ソースコードのの可読性を保つために記載しています。
&は、文字と文字や文字とvbLfをつなぐためのものです。
最後に、If rSelectedRange Is Nothing Then Exit Subは、ユーザーが入力フォームの「キャンセル」ボタンを押した際にrSelectedRange 変数にNothingが入力されることを利用し、キャンセルボタンが押された際にはマクロが終了します。
ユーザーが選択したセルから「抽出対象文字列」取得.
空白セルが選択されていた場合はマクロを終了
'選択されたセルから走査対象の文字列を取得
sScanningTarget = rSelectedRange.Value
'選択されたセルが空白だった場合、マクロを終了する
If sScanningTarget = "" Then _
'メッセージボックス表示
MsgBox ("エラー発生。" & vbLf & _
"エラー内容：選択したセルが空白セルであったため。")
'マクロ終了
Exit Sub
End IfrSelectedRange.Valueの内、rSelectedRangeにはユーザーが選択したセル情報がRange型オブジェクトとして格納されています。
Range型オブジェクトのValueプロパティを指定することで、そのセル(範囲)内の記載されている「文字列」や「数値」情報を取得できます。
ここでは、ユーザーが選択したセル内の情報を、String型の変数であるsScanningTargetに格納しています。
If sScanningTarget = “” Then _により、取得した情報が””(空欄)であるか判定します。
空欄だった場合、メッセージボックスを表示してエラーの旨をユーザーに伝え、
Exit Subを実施することでマクロを終了します。
データを転記するためのワークシート追加
'抽出対象のデータが記載されているワークシート名
sActiveWorksheetName = ActiveSheet.Name
'抽出データを転記するためのワークシートを追加し、追加したシートの名前を変更
Worksheets.Add After:=ActiveSheet, Count:=1
ActiveSheet.Name = "データ抽出(" & sScanningTarget & ")"
'データが記載されているワークシートを選択
Worksheets(sActiveWorksheetName).SelectsActiveWorksheetName = ActiveSheet.Nameの右辺にあるActiveSheetは、現在アクティブセルがあるワークシートを指しています。
マクロを呼び出す前に、転記したいデータがあるワークシートにアクティブセルを動かしておいてください。
ユーザー改造箇所
Worksheets.Add After:=ActiveSheet, Count:=1
ActiveSheet.Name = “データ抽出(” & sScanningTarget & “)”
ここで、追加するワークシートを作成します。ユーザ改造箇所は、
ActiveSheet.Name = “データ抽出(” & sScanningTarget & “)”の右辺です。
この右辺は、ユーザーが自由に設定できます。
“”(ダブルクォーテーション)で囲ったものが文字列として認識され、ワークシート名になります。
デフォルトだと、「初めにユーザーが選択したセルに記載の文字列」がワークシート名に入るような作りになっています。
(改造おわり)
ワークシートを追加した後、アクティブセルが新規追加したワークシートに移っています。
Worksheets(sActiveWorksheetName).Selectにより、マクロを呼び出す前にユーザーに移ってもらった、抽出したいデータが記載されているワークシートに戻ります。
転記ループ処理の開始
'列列方向で5回連続で空白セルを読み込むまで走査
Do While iExtractCountor >= 0
・・・
・・・
・・・
LOOPDo While～LOOPの間の処理を、iExtractCountor >= 0の条件が満たされている間繰り返します。
iExtractCountorはint型の変数で0に初期化しており、繰り返し処理の間でも0未満になることはありません。そこで繰り返し処理を抜けるために、処理中に”Exit sub”が記載してあります。Exit subが実行されると、関数の処理が終了するので、繰り返し処理も終了になります。
Do While～LOOPの間にも、他のDo While～LOOP処理が入っております。それぞれの処理がどう対応しているかは、「タブスペース」を入れて見た目でもわかりやすくしております。
列方向への操作_抽出対象セルの検索
列方向の操作は、下図の①-２の方向に該当します。
'行方向の走査カウンターをリセット
iColumnBlankCountor = 0
'抽出対象の右端列番号を設定
iNumberOfRightEdge = rExtractBaseCell.Column
'アクティブセルが抽出対象か否かの判定フラグを倒す
bCheckValue = False
'列方向に走査
'アクティブセルが抽出対象のセルになるまで走査を継続
Do While bCheckValue = False
'アクティブセルが抽出対象の文字列が記載されているセルの場合
If rExtractBaseCell.Value = sScanningTarget Then _
'判定フラグを立てる
bCheckValue = True
'アクティブセルが空白の場合
ElseIf rExtractBaseCell.Value = "" Then _
'連続して空白を読み込んだカウンターをインクリメント
iColumnBlankCountor = iColumnBlankCountor + 1
'5回以上連続して空白セルを走査した場合
If iColumnBlankCountor >= 5 Then _
'データの抽出が完了したことをユーザーに伝えるメッセージボックスを表示
MsgBox ("抽出完了!" & vbLf & _
"作成したシート名：データ抽出(" & sScanningTarget & ")" & vbLf & _
"抽出したデータ数：" & iExtractCountor & "行分")
'マクロを終了させる
Exit Sub
'空白セルの連続走査が5回未満の場合
Else
'走査セルの行番号を1行下に設定
Set rExtractBaseCell = rExtractBaseCell.Offset(1, 0)
End If
'アクティブセルに抽出対象の文字列が記載されていない、かつ、空白ではない場合
Else
'走査セルの行番号を1行下に設定
Set rExtractBaseCell = rExtractBaseCell.Offset(1, 0)
'連続して空白を読み込んだカウンターを0リセット
iColumnBlankCountor = 0
End If
Loop
ユーザーが選択したセルを起点に①-２方向へ操作します。
「 If rExtractBaseCell.Value = sScanningTarget Then _」では、 rExtractBaseCellで指定しているアクティブセルが、ユーザーが初めに選択したセルに記載されている文字列かどうか判定しています。
同一の文字列であった場合、bCheckValue = Trueの処理によりフラグを立てます。これで、下方向への操作ループであるDo While bCheckValue = Falseの条件を満たさなくなり、列方向への走査ループから抜けます。
同一の文字列でなかった場合、 「ElseIf rExtractBaseCell.Value = “” Then _」の判定に移ります。これは、走査対象のアクティブセルが「空白セル」かを判定しています。空白セルが列方向に５回連続すると、Exit Subでマクロが終了します。
アクティブセルが「走査対象の文字列」または「空白セル」ではない場合、「Set rExtractBaseCell = rExtractBaseCell.Offset(1, 0)」の処理を実施します。.Offset(1, 0)で列方向一つ下に移動します。そして、またDo While bCheckValue = Falseの戻り、ループが走ります。
ユーザーへの注意喚起！
上記の通り、列方向の走査は「空白セルが連続しているかどうか」で検索しています。
注意していただきのは、「見た目は空白セルだけど、Excel関数などが記載されている場合」です。
会社の規定フォーマット上で、走査列全てに何かしらの値が入っている場合、マクロが無限ループに入ってしまいます。
マクロを動かす前に、「走査対象列が空白か？」確認願います。
行方向に走査_データが記載されている右終端列番号を取得
行方向の操作は、下図の①-１の方向に該当します。
'行方向に連続して空白を読み込んだカウンター
iColumnBlankCountor = 0
'行方向に読み込んだセル数カウンター
iColumnCountor = 0
'行方向に走査
'連続したNULLセルが3回続くまで走査し、データが記載されている右終端列番号を取得する
Do While iColumnBlankCountor < 3
On Error Resume Next
'アクティブセルが"NULL"か判定
If Cells(rExtractBaseCell.Row, iNumberOfRightEdge) = "" Then _
'行方向の、連続した空白カウンターをインクリメント
iColumnBlankCountor = iColumnBlankCountor + 1
Else
'連続していない場合は0リセット
iColumnBlankCountor = 0
End If
On Error GoTo 0
'行方向に読み込んだセルの個数をカウント
iColumnCountor = iColumnCountor + 1
'無限ループを避けるためのガード処理を実施
'行方向の読み取り上限：50個
If iColumnCountor >= 50 Then _
MsgBox ("通知：行方向に50個のセルを読み込んだため次の列走査に移行" & vbLf & _
"確認：通知を読んだらOKを押してください)")
'カウンターを操作して行方向の操作を終了
iColumnBlankCountor = 5
End If
'抽出を対象の右端列番号をインクリメント
iNumberOfRightEdge = iNumberOfRightEdge + 1
Loop初めに、 iColumnBlankCountor = 0, iColumnCountor = 0で、Do while内で使用するカウンターを0に初期化します。
Do While iColumnBlankCountor < ３ … Loopの間の処理を、iColumnBlankCountorが３以上になるまでループします。
On Error Resume NextからOn Error GoTo 0の間の処理では、If-Elseの判定処理によりアクティブセルがNULL（空）であるか確認しています。NULLの場合は iColumnBlankCountorが1加算されます。ここで加算された数字が３以上になったとき、次のループ処理の開始時にループから抜けます。
ユーザー改造箇所
If iColumnCountor >= ５０Then _の数字５０。この数字が改造ポイントです。
この数字分行方向にセルを読み込むと、「MsgBox (“通知：行方向…」が表示され、行方向の走査が終了します。
ユーザーの都合に合わせて、この数字を１００に増やしても、３０に減らしても、任意の数字に設定していただいて大丈夫です。
(改造箇所終了)
ループ内の最後でiNumberOfRightEdgeのカウンターを１加算します。ここで加算された数字は、「行方向→列方向に走査したデータを転記」で使用されます。
その後、Do While iColumnBlankCountor < ３の判定個所に戻ります。
行方向→列方向に走査したデータを転記
'転記先シートへ移動
Set rTarget = Worksheets("データ抽出(" & sScanningTarget & ")").Range("B" & iRowNum)
'行方向への走査が終わったので、データの転記を実施
'抽出対象の文字列が記載されているセルから、データが記載されている右終端の列番号までのセル範囲をコピー。新規シートにデータを転記。
For Each rCopy In Range(Cells(rExtractBaseCell.Row, rExtractBaseCell.Column), Cells(rExtractBaseCell.Row, iNumberOfRightEdge))
'転記先シートへデータを転記
rTarget.Value = rCopy.Value
'転記先の行番号は変えず、列を右方向に1つずらす
Set rTarget = rTarget.Offset(0, 1)
Next
'転記先行番号をインクリメント
iRowNum = iRowNum + 1 Set rTargetは =、Range型オブジェクトに右辺のセル情報を設定します。Worksheets(“データ抽出(” & sScanningTarget & “)”).で、本マクロ中に新規作成したシートを指定します。Range(“B” & iRowNum)で、セルB２を指定します。B２のBはRangeの中で指定し、２は本マクロ中でiRowNumに入力された数字が入ります。
次にFor Each rCopy In Range(Cells(rExtractBaseCell.Row, rExtractBaseCell.Column), Cells(rExtractBaseCell.Row, iNumberOfRightEdge))の説明です。
For Each rCopy In Range（A, B）…Nextは構文で、「rCopyの変数に、AからBまでのセルを一つずつ格納するループ処理」を実行します。今回だと、AがCells(rExtractBaseCell.Row, rExtractBaseCell.Column、BがCells(rExtractBaseCell.Row, iNumberOfRightEdge)に該当します。AとBどちらもCells(a,b)で記載されていますが、Cellsは名前の通りセルを指定します。
Aは列番号がrExtractBaseCell.Row(ユーザーが初めに指定したセルの列位置)、
行番号がrExtractBaseCell.Column((ユーザーが初めに指定したセルの行位置)。
Bは列番号がrExtractBaseCell.Row(ユーザーが初めに指定したセルの列位置)でAと同じ、
行番号が iNumberOfRightEdge(「行方向に走査_データが記載されている右終端列番号を取得」で取得した行方向のデータが詰まっている右端)です。
下図に示すAからBまでのセルを一つずつrCopy に入れて、Nextの市まで処理し、次のセルに移動していきます。
rTarget.Value = rCopy.Valueでは、左辺の転記先セル内の情報を、右辺の転記元データに書き換えています。 rCopy.は、For Each rCopy のもので、この変数がループ処理で変化していきます。
上記のデータ書き換えのあと、次の走査が始まる前にSet rTarget = rTarget.Offset(0, 1)で、左辺の転記先セルを移動させます。この処理がないと、右辺の rCopyの値が走査できても左辺のrTargetはずっと同じセルを指定し、転記走査ができません。
For Eachのループ処理が終了すると、一行分の転記が完了です。iRowNum = iRowNum + 1でrTargetを1行下に動かし、次の行の転記へ備えます。
↑３.ソースコード概要一覧に戻る
抽出データが記載されているシートへ戻り、次の検索へ
'抽出元データが記載されているシートへ移動
Worksheets(sActiveWorksheetName).Select
'列方向の抽出走査セルを1行下に移動させ、次の列方向走査に備える
Set rExtractBaseCell = rExtractBaseCell.Offset(1, 0)
'抽出実行カウンターをインクリメント
iExtractCountor = iExtractCountor + 1 Worksheets(sActiveWorksheetName).Selectで、抽出データが記載されているシートへ移動します。
Set rExtractBaseCell = rExtractBaseCell.Offset(1, 0)で、抽出検索セルを一行下に動かし、次の検索に備えます。
最後にiExtractCountor = iExtractCountor + 1でカウンターを１加算します、このカウンターは、マクロ動作完了後にユーザーへ「〇〇行転記しました！」と表示するために使用します。