遠征に行ったときに見た生き物や、生物相調査時に見られた生物をリストにまとめるとき、いちいち学名を調べたり、順番に並べるのは骨が折れますよね。
どうにか楽に出来ないものか、試行錯誤してみました。
結果、事前にエクセルに参照するリストを用意しておけば、対応する和名欄の横に学名を出力したり、順番に並べられるようにはなったので、その方法を紹介しようと思います。
これ↑が
こうなります。
では、そのやり方。
まず、エクセルを起動し、空白のブックを選択します。
今回は練習ということで、僕がつくば市で撮影済みのトンボのリストにしました。本来なら、日本産のトンボ全種などにするのが理想です。
左端（A列）に番号を付けることで、1種1種に番号を割り振ります。
実際に書いていくのは面倒なので、こちら↓のリストをコピーして貼り付けてください。
次に、左下のSheet1をクリックして、Sheet1に移動します。
Sheet1に和名を記入しマクロを実行すると、Sheet2を参考に学名や、種番号がSheet1にコピーされてくる、という仕組みです。
書き終わったら、キーボードの「Altキー」と「F11」キーを同時に押します。
何だかよくわからないウィンドウ（VBEというらしい）が出てきたはずです。
右の小さなウィンドウ（赤枠）の中に、以下のスクリプトをコピーして貼り付けてください。
Sub 和名から学名や番号の付与(）
'高速化するために表示内容の更新を一端停止
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'変数を宣言
Dim workSh, refSh As Worksheet
Dim RowStart As String
Dim refJpnNameCol As Integer
Dim JpnNameCol As Integer
Dim MaxRow As Integer
Dim refMaxRow As Integer
Dim refRng As Range
Dim workingRow As Integer
Dim tmpStr As String
'☆Sheet1の和名は何行目から記入したか
RowStart = 2
'☆Sheet1の和名は何列目に記入したか
JpnNameCol = 4
'☆Sheet2(検索される側)の和名は何列目に記入したか
refJpnNameCol = 4
'☆何列目を検索対象とするか
refA = 1
refB = 2
refC = 3
refD = 5
'☆何列目に出力するか(outputAはrefAに対応)
outputA = 1
outputB = 2
outputC = 3
outputD = 5
'どのシートに出力するか
Set workSh = ThisWorkbook.Worksheets("Sheet1")
'どのシートを参照するか
Set refSh = ThisWorkbook.Worksheets("Sheet2")
'Sheet1の最終行をMaxRowに代入
With Worksheets("Sheet1").UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
End With
'Sheet2の最終行をrefMaxRowに代入
With Worksheets("Sheet2").UsedRange
refMaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
End With
'検索対象の範囲指定
Set refRng = Worksheets("Sheet2").Range(refSh.Cells(1, refJpnNameCol), refSh.Cells(refMaxRow, refJpnNameCol))
'↓1行ずつ検索し、該当する箇所を出力欄にコピー（開始）
For workingRow = RowStart To MaxRow
tmpStr = workSh.Cells(workingRow, JpnNameCol).Value
On Error Resume Next
'☆出力したい列数に合わせて1行ずつ便宜追加、削除しよう1/2（始め）
refSh.Cells(Application.WorksheetFunction.match(tmpStr, refRng, 0), refA).Copy workSh.Cells(workingRow, outputA)
refSh.Cells(Application.WorksheetFunction.match(tmpStr, refRng, 0), refB).Copy workSh.Cells(workingRow, outputB)
refSh.Cells(Application.WorksheetFunction.match(tmpStr, refRng, 0), refC).Copy workSh.Cells(workingRow, outputC)
refSh.Cells(Application.WorksheetFunction.match(tmpStr, refRng, 0), refD).Copy workSh.Cells(workingRow, outputD)
'☆出力したい列数に合わせて1行ずつ便宜追加、削除しよう1/2（終わり）
If Err <> 0 Or workSh.Cells(workingRow, JpnNameCol).Value = "和名未定" Then
'☆出力したい列数に合わせて1行ずつ便宜追加、削除しよう2/2（始め）
workSh.Cells(workingRow, outputA).Value = ""
workSh.Cells(workingRow, outputB).Value = ""
workSh.Cells(workingRow, outputC).Value = ""
workSh.Cells(workingRow, outputD).Value = ""
'☆出力したい列数に合わせて1行ずつ便宜追加、削除しよう2/2（終わり）
Err.Clear
End If
'進捗状況をステータスバーに表示
Application.StatusBar = "処理中" & workingRow & "/" & MaxRow
Next
'↑1行ずつ検索し、該当する箇所を出力欄にコピー（終了）
'処理終了をステータスバーに表示
Application.StatusBar = "処理終了"
'表示される内容の更新
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
列を追加したり減らしたい等、自分好みにカスタマイズしたい場合は☆マークの部分をいじってください。
refは参照される側（Sheet2）の列数を、outputは出力される側（Sheet1）の列数をあらわしています。refAに書かれている内容はoutputAに、refBに書かれている内容はoutputBに出力されるようになっているので、refA = 1, outputA = 2に書き換えれば、Sheet2の1列目がSheet1の2列目にコピー(出力)されることになります。
始めにSheet2に参照するリストを作っておくのが非常に面倒ですが、一度作ってしまえば後は楽なので、ぜひ試してみてください。
説明は以上です。
もっととっつきやすい方法もあると思います。スクリプトは改変して再配布してもらって構いません。より良い方法があれば、教えていただけれるとうれしいです。また、VBA初心者のため変な部分もあるかもしれません。改善点や質問があればぜひコメント欄にお願いします。
0 件のコメント:
コメントを投稿