この記事では、指定した列の文字列が左右の表で一致する場合にデータを同じ行に揃える方法についてご説明します。
【動画】指定した列の文字列が左右の表で一致する場合にデータを同じ行に揃える実際の動き
本題に入る前に、まずは次の動画をご覧ください。
まずは左表の列「名前」にある値(名前)を右表に対して検索します。
もし検索して存在していれば、その値(名前)に合致する行の値を左表の行位置にと同じに合わせて並ばせます。
合致する値(名前)全て並ばせたら、次に右表には存在するけど左表には存在しない値(名前)を検索します。
存在しない値(名前)が特定出来たら、その存在しない値(名前)の行の値を、「テストデータ①の表に存在しないデータ」の表に全て出力させます。
マクロ作成の流れ
Excelファイルの例
今回は次のExcelファイルを用意しました。
配置されているセルの名前は次の通りです。
lftTblBgnCol
左の表の先頭列(今回のサンプルではA列)を指定するセルに「lftTblBgnCol」という名前を付けています。
上の画像では、名前がlftTblBgnColのセルにAを入力していますが、これは左の表の先頭列をA列に指定することを意味します。
lftTblLstCol
左の表の最終列(今回のサンプルではH列)を指定するセルに「lftTblLstCol」という名前を付けています。
上の画像では、名前がlftTblLstColのセルにHを入力していますが、これは左の表の最終列をH列に指定することを意味します。
kDataCol
左の表の検索元としたい値の列位置(今回のサンプルではB列)を指定するセルに「kDataCol」という名前を付けています。
上の画像では、名前がkDataColのセルにBを入力していますが、これは左の表の検索元としたい値の列位置をBに指定することを意味します。
rgtTblBgnCol
右の表の先頭列(今回のサンプルではJ列)を指定するセルに「rgtTblBgnCol」という名前を付けています。
上の画像では、名前がrgtTblBgnColのセルにJを入力していますが、これは右の表の先頭列をJ列に指定することを意味します。
rgtTblLstCol
右の表の最終列(今回のサンプルではQ列)を指定するセルに「lftTblLstCol」という名前を付けています。
上の画像では、名前がlftTblLstColのセルにQを入力していますが、これは右の表の最終列をQ列に指定することを意味します。
fDataCol
右の表の検索元としたい値の列位置(今回のサンプルではK列)を指定するセルに「fDataCol」という名前を付けています。
上の画像では、名前がkDataColのセルにKを入力していますが、これは右の表の検索先としたい値の列位置をKに指定することを意味します。
ndTblBgnCol
「テストデータ①の表に存在しないデータ」の表の先頭列(今回のサンプルではS列)を指定するセルに「ndTblBgnCol」という名前を付けています。
上の画像では、名前がlftTblBgnColのセルにAを入力していますが、これは「テストデータ①の表に存在しないデータ」の表の先頭列をS列に指定することを意味します。
ndTblLstCol
「テストデータ①の表に存在しないデータ」の表の最終列(今回のサンプルではZ列)を指定するセルに「ndTblLstCol」という名前を付けています。
上の画像では、名前がndTblLstColのセルにZを入力していますが、これは「テストデータ①の表に存在しないデータ」の表の最終列をZ列に指定することを意味します。
dataBgnRow
データの先頭行(今回のサンプルでは17行目)を指定するセルに「dataBgnRow」という名前を付けています。
上の画像では、名前がdataBgnRowのセルに17を入力していますが、これは17行目をデータの先頭だと指定することを意味します。
dataLstRow
データの最終行(今回のサンプルでは36行目)を指定するセルに「dataLstRow」という名前を付けています。
上の画像では、名前がdataLstRowのセルに36を入力していますが、これは36行目をデータの最終行だと指定することを意味します。
コードの例
Excelのマクロのコード(例)
Option Explicit
Sub dataSort()
Dim ws As Worksheet 'ワークシート用変数
Dim dataBgnRow As Long 'データの先頭行
Dim dataLstRow As Long 'データの最終行
Dim kDataCol As Long '左表(テストデータ①)の検索元としたい値の列位置
Dim fDataCol As Long '右表(テストデータ②)の検索先としたい値の列位置
Dim rgtTblBgnCol As Long '右表(テストデータ②)の先頭列
Dim rgtTblLstCol As Long '右表(テストデータ②)の最後列
Dim ndTblBgnCol As Long '「テストデータ①の表に存在しないデータ」の表の先頭列
Dim ndTblLstCol As Long '「テストデータ①の表に存在しないデータ」の表の最後列
Dim rowNum As Long '表の行数
Dim colNum As Long '表の列数
Dim getValAry() As Variant '右表(テストデータ②)のデータを格納するための配列
Dim noDataGetValAry() As Variant '左表(テストデータ①)に存在しないデータを格納するための配列
Dim cCnt As Long 'セルの行のカウント用カウンタ
Dim rCnt As Long 'セルの行のカウント用カウンタ
Dim fndData As Range '検索したデータ
Dim dataExistCnt As Long '存在するデータの件数を数えるカウンタ
'本マクロのブックのシート名を取得する
Set ws = Worksheets("work")
'データの先頭行を取得する
dataBgnRow = ws.Range("dataBgnRow").Value
'データの最終行を取得する
dataLstRow = ws.Range("dataLstRow").Value
'左表(テストデータ①)の検索元としたい値の列位置を取得する
kDataCol = ws.Range(ws.Range("kDataCol").Value & 1).Column
'右表(テストデータ②)の検索先としたい値の列位置を取得する
fDataCol = ws.Range(ws.Range("fDataCol").Value & 1).Column
'右表(テストデータ②)の先頭列を取得する
rgtTblBgnCol = ws.Range(ws.Range("rgtTblBgnCol").Value & 1).Column
'右表(テストデータ②)の最終列を取得する
rgtTblLstCol = ws.Range(ws.Range("rgtTblLstCol").Value & 1).Column
'「テストデータ①の表に存在しないデータ」の表の先頭列を取得する
ndTblBgnCol = ws.Range(ws.Range("ndTblBgnCol").Value & 1).Column
'「テストデータ①の表に存在しないデータ」の表の最後列を取得する
ndTblLstCol = ws.Range(ws.Range("ndTblLstCol").Value & 1).Column
'表の行数を取得する
rowNum = (ws.Range("dataLstRow").Value - ws.Range("dataBgnRow").Value) + 1
'表の列数を取得する
colNum = (ws.Range(ws.Range("lftTblLstCol").Value & 1).Column - ws.Range(ws.Range("lftTblBgnCol").Value & 1).Column) + 1
'右表(テストデータ②)のデータを格納するための配列getValAryを初期化する
ReDim getValAry(rowNum - 1, colNum - 1)
'左表(テストデータ①)に存在しないデータを格納するための配列noDataGetValAryを初期化する
ReDim noDataGetValAry(rowNum - 1, colNum - 1)
'左表(テストデータ①)の行数分ループを行う
For rCnt = 0 To rowNum - 1
'左表(テストデータ①)の生徒名を、右表(テストデータ②)に対して検索する
Set fndData = ws.Range(ws.Cells(dataBgnRow, fDataCol), ws.Cells(dataLstRow, fDataCol)).Find(ws.Cells(dataBgnRow + rCnt, kDataCol), _
LookAt:=xlWhole)
If Not fndData Is Nothing Then
'データが存在しない場合
'右表(テストデータ②)の列分ループを行う
For cCnt = 0 To colNum - 1
'左表(テストデータ①)の生徒名に合致した右表(テストデータ②)の生徒の各データ(生徒名と点数)を配列に格納する
getValAry(rCnt, cCnt) = ws.Cells(fndData.Row, ws.Range(ws.Range("rgtTblBgnCol").Value & 1).Column + cCnt)
Next
End If
Next
'右表(テストデータ②)の行数分ループを行う
For rCnt = 0 To rowNum - 1
'右表(テストデータ②)の生徒名を、左表(テストデータ①)に対して検索する
Set fndData = ws.Range(ws.Cells(dataBgnRow, kDataCol), ws.Cells(dataLstRow, kDataCol)).Find(ws.Cells(dataBgnRow + rCnt, fDataCol), _
LookAt:=xlWhole)
If fndData Is Nothing Then
'右表(テストデータ②)のデータが左表(テストデータ①)に存在する場合
'右表(テストデータ②)の列分ループを行う
For cCnt = 0 To colNum - 1
'右表(テストデータ②)の生徒名に合致した左表(テストデータ①)の生徒の、右表(テストデータ②)側の各データ(生徒名と点数)を配列に格納する
noDataGetValAry(dataExistCnt, cCnt) = ws.Cells(dataBgnRow + rCnt, ws.Range(ws.Range("rgtTblBgnCol").Value & 1).Column + cCnt)
Next
'カウンタを1つ増やす
dataExistCnt = dataExistCnt + 1
End If
Next
'右表(テストデータ②)をクリアする
ws.Range(ws.Cells(dataBgnRow, rgtTblBgnCol), ws.Cells(dataLstRow, rgtTblLstCol)).ClearContents
'「テストデータ①の表に存在しないデータ」の表をクリアする
ws.Range(ws.Cells(dataBgnRow, ndTblBgnCol), ws.Cells(dataLstRow, ndTblLstCol)).ClearContents
'右表(テストデータ②)にデータを貼り付ける
ws.Range(ws.Cells(dataBgnRow, rgtTblBgnCol), ws.Cells(dataLstRow, rgtTblLstCol)).Value = getValAry
'「テストデータ①の表に存在しないデータ」の表にデータを貼り付ける
ws.Range(ws.Cells(dataBgnRow, ndTblBgnCol), ws.Cells(dataLstRow, ndTblLstCol)).Value = noDataGetValAry
End Sub
コードの解説
注目すべきコード①
最初に見て頂きたいのは27行目から54行目です。
'データの先頭行を取得する
dataBgnRow = ws.Range("dataBgnRow").Value
'データの最終行を取得する
dataLstRow = ws.Range("dataLstRow").Value
'左表(テストデータ①)の検索元としたい値の列位置を取得する
kDataCol = ws.Range(ws.Range("kDataCol").Value & 1).Column
'右表(テストデータ②)の検索先としたい値の列位置を取得する
fDataCol = ws.Range(ws.Range("fDataCol").Value & 1).Column
'右表(テストデータ②)の先頭列を取得する
rgtTblBgnCol = ws.Range(ws.Range("rgtTblBgnCol").Value & 1).Column
'右表(テストデータ②)の最終列を取得する
rgtTblLstCol = ws.Range(ws.Range("rgtTblLstCol").Value & 1).Column
'「テストデータ①の表に存在しないデータ」の表の先頭列を取得する
ndTblBgnCol = ws.Range(ws.Range("ndTblBgnCol").Value & 1).Column
'「テストデータ①の表に存在しないデータ」の表の最後列を取得する
ndTblLstCol = ws.Range(ws.Range("ndTblLstCol").Value & 1).Column
'表の行数を取得する
rowNum = (ws.Range("dataLstRow").Value - ws.Range("dataBgnRow").Value) + 1
'表の列数を取得する
colNum = (ws.Range(ws.Range("lftTblLstCol").Value & 1).Column - ws.Range(ws.Range("lftTblBgnCol").Value & 1).Column) + 1
コードの説明
以上のコードは、表の各情報を取得して変数に格納するコードです。
表の各情報は、データを検索したり、検索して合致したデータを表にそのデータを出力するのに使います。
コードの詳細
27行目のコードでは、データの先頭行を取得します。
30行目のコードでは、データの最終行を取得します。
33行目のコードでは、左表(テストデータ①)の検索元としたい値の列位置を取得します。
36行目のコードでは、右表(テストデータ②)の検索先としたい値の列位置を取得します。
39行目のコードでは、右表(テストデータ②)の先頭列を取得します。
42行目のコードでは、右表(テストデータ②)の最終列を取得します。
45行目のコードでは、「テストデータ①の表に存在しないデータ」の表の先頭列を取得します。
48行目のコードでは、「テストデータ①の表に存在しないデータ」の表の最後列を取得します。
51行目のコードでは、表の行数を取得します。
54行目のコードでは、表の列数を取得します。
注目すべきコード②
次に見て頂きたいのは57行目から60行目です。
'右表(テストデータ②)のデータを格納するための配列getValAryを初期化する
ReDim getValAry(rowNum - 1, colNum - 1)
'左表(テストデータ①)に存在しないデータを格納するための配列noDataGetValAryを初期化する
ReDim noDataGetValAry(rowNum - 1, colNum - 1)
コードの説明
以上のコードは、ReDimを使って配列getValとnoDataGetValの要素数を再定義するコードです。
表の行数と列数に合わせて、配列getValとnoDataGetValの要素数を設定しています。
「rowNum – 1」が行数、「colNum – 1」が列数です。
注目すべきコード③
次に見て頂きたいのは63行目から83行目です。
'左表(テストデータ①)の行数分ループを行う
For rCnt = 0 To rowNum - 1
'左表(テストデータ①)の生徒名を、右表(テストデータ②)に対して検索する
Set fndData = ws.Range(ws.Cells(dataBgnRow, fDataCol), ws.Cells(dataLstRow, fDataCol)).Find(ws.Cells(dataBgnRow + rCnt, kDataCol), _
LookAt:=xlWhole)
If Not fndData Is Nothing Then
'データが存在しない場合
'右表(テストデータ②)の列分ループを行う
For cCnt = 0 To colNum - 1
'左表(テストデータ①)の生徒名に合致した右表(テストデータ②)の生徒の各データ(生徒名と点数)を配列に格納する
getValAry(rCnt, cCnt) = ws.Cells(fndData.Row, ws.Range(ws.Range("rgtTblBgnCol").Value & 1).Column + cCnt)
Next
End If
Next
コードの説明
以上のコードは、左表のB列「名前」にある値(名前)を右表のK列の名前に対して検索し、もし検索して存在していれば、その値(名前)に合致する行の値を配列getValAryに格納するコードです。
この配列のデータは後ほど右表(テストデータ②)に出力します。
コードの詳細
63行目のFor文は、行数rowNumの数だけループするFor文です。
表の1行ずつ、左表のB列の名前を元に、右表のK列に名前が存在するか66行目で検索します。
検索はFindメソッドを使います。
もし検索して合致する(ヒットする)名前が存在している場合は、77行目でその名前の各点数のデータを配列getValAryに格納します。(74行目のFor文で各点数のデータを繰り返し配列getValAryに格納します)
注目すべきコード④
次に見て頂きたいのは86行目から109行目です。
'右表(テストデータ②)の行数分ループを行う
For rCnt = 0 To rowNum - 1
'右表(テストデータ②)の生徒名を、左表(テストデータ①)に対して検索する
Set fndData = ws.Range(ws.Cells(dataBgnRow, kDataCol), ws.Cells(dataLstRow, kDataCol)).Find(ws.Cells(dataBgnRow + rCnt, fDataCol), _
LookAt:=xlWhole)
If fndData Is Nothing Then
'右表(テストデータ②)のデータが左表(テストデータ①)に存在する場合
'右表(テストデータ②)の列分ループを行う
For cCnt = 0 To colNum - 1
'右表(テストデータ②)の生徒名に合致した左表(テストデータ①)の生徒の、右表(テストデータ②)側の各データ(生徒名と点数)を配列に格納する
noDataGetValAry(dataExistCnt, cCnt) = ws.Cells(dataBgnRow + rCnt, ws.Range(ws.Range("rgtTblBgnCol").Value & 1).Column + cCnt)
Next
'カウンタを1つ増やす
dataExistCnt = dataExistCnt + 1
End If
Next
コードの説明
以上のコードは、右表のK列「名前」にある値(名前)を左表のB列の名前に対して検索し、もし検索して存在していれば、その値(名前)に合致する右表(テストデータ②)の行の値を配列noDataGetValAryに格納するコードです。
この配列のデータは後ほど「テストデータ①の表に存在しないデータ」の表に出力します。
コードの詳細
86行目のFor文は、行数rowNumの数だけループするFor文です。
左表の1行ずつ、右表のK列の名前を元に、左表のB列に名前が存在するか89行目で検索します。
検索はFindメソッドを使います。
もし検索して合致した(ヒットした)名前が存在している場合は、100行目でその名前の各点数のデータを配列noDataGetValAryに格納します。(74行目のFor文で各点数のデータを繰り返し配列getValAryに格納します)
注目すべきコード⑤
次に見て頂きたいのは112行目から115行目です。
'右表(テストデータ②)をクリアする
ws.Range(ws.Cells(dataBgnRow, rgtTblBgnCol), ws.Cells(dataLstRow, rgtTblLstCol)).ClearContents
'「テストデータ①の表に存在しないデータ」の表をクリアする
ws.Range(ws.Cells(dataBgnRow, ndTblBgnCol), ws.Cells(dataLstRow, ndTblLstCol)).ClearContents
コードの説明
以上のコードは、右表(テストデータ②)と「テストデータ①の表に存在しないデータ」の表をクリアする処理です。
右表(テストデータ②)と「テストデータ①の表に存在しないデータ」の表に該当データを出力するために、一旦表をクリアしておきます。
注目すべきコード⑥
次に見て頂きたいのは118行目から121行目です。
'右表(テストデータ②)にデータを貼り付ける
ws.Range(ws.Cells(dataBgnRow, rgtTblBgnCol), ws.Cells(dataLstRow, rgtTblLstCol)).Value = getValAry
'「テストデータ①の表に存在しないデータ」の表にデータを貼り付ける
ws.Range(ws.Cells(dataBgnRow, ndTblBgnCol), ws.Cells(dataLstRow, ndTblLstCol)).Value = noDataGetValAry
コードの説明
以上のコードは、配列getValAryの値を右表(テストデータ②)に、配列noDataGetValAryの値を右表(テストデータ②)に「テストデータ①の表に存在しないデータ」の表に出力する処理のコードです。
Rangeの1つ目の引数には表の行と列の先頭位置を、2つ目の引数には行と列の最終位置を指定してValueプロパティに配列を代入すると、Rangeプロパティで指定した表の範囲に対して値を一括で表に出力することができます。
動作確認
マクロ実行前
今回は以下のExcelファイルを用意しました。
左表(テストデータ①)には、4件データが存在しています。
この4件のデータの名前(B列)と同じ名前が右側の表のK列に存在していれば、(右側の表の)同じ行にその名前のデータを出力させます。
また、右表には存在するけど左表には存在しない値(名前)が存在していなければ、その値(名前)に合致する行の値を「テストデータ①の表に存在しないデータ」の表に出力させます。(上詰めで)
マクロ実行後
マクロ実行後は、名前が合致する4件のデータが左と右の表で同じ行位置で表示されています。
また、4件のデータ以外のデータは、「テストデータ①の表に存在しないデータ」の表に出力されています。
最後に
この記事では、指定した列の文字列が左右の表で一致する場合にデータを同じ行に揃える方法についてご説明しました。
左表のデータの並びの通りに、右表も同じ並びにしたい時は本記事が参考になるかもしれないので参考にしてみてくださいね。
プログラミングのスキルを習得するなら
プログラミングのスキルを習得したい、今のスキルをもっと高めたい、そう考えているなら「プログラミングスクール」がおすすめです。
プログラミングのスキルの基礎を身につけるなら「TechAcademy」で1週間の無料体験があるので、これで「プログラミングの基礎」を学ぶのにおすすめですよ。
