#はじめに
- 私は実験をメインに行う大学院生(2020年11月現在)です.
- 条件の振り方によっては,大量のデータが得られることがあります.
- 少しでも解析を楽にしたいのと,個人的な趣味とで,時々Excelのマクロを組みます.
- 忘れっぽいので,気が向いたときにQiitaにまとめています.
#状況説明
適当な例として,250 K, 300 K, 350 Kの三条件で温度依存性のデータを取った場合を考えます.
過去に「マクロの乗ったExcelファイルと同じディレクトリにあるcsvファイルを全て読み込むやつ」を作っているので,これを使って3つのcsvファイルを一つのワークブックにまとめます.
ここで,ワークシート「Data1」は以下のようになっています.
V1とかI1はそれぞれ,電圧とか電流を想定して書いています.
#やりたいこと
新しく「Summary」というワークシートを作り,そこに(i)と(iii)だけ引っこ抜いていきたい.
上の画像だけ見ると,シンプルにA11からF22までの範囲をコピーすればいいじゃんという気がする.しかし,条件を変えると「(iii) 測定データ」の範囲が変わってしまう.具体的には,
- V1の掃引範囲を1~10でなく,1~20にすると(iii)が縦に伸びる
- 記録する変数をV1, I1だけにすると,(iii)が横に縮む
- 「(ii) 測定条件など」の範囲は測定によって変わるので,(iii)の開始位置が必ずA11になる保証はない
なので,今回やりたいことは 各測定データに応じて「(iii) 測定データ」の範囲を検出し,「(i)オリジナルのファイル名」とセットで「Summary」というワークシートにコピーしてくる です.
#アプローチ
幸いなことに,「(iii) 測定データ」は,必ず一番下に来ることが決まっています.
「(ii) 測定条件など」と「(iii) 測定データ」の順番が入れ替わることはありません.
また,測定データは左詰めで記録されるので,左端の列番号は必ず「1」になります.
なので,以下のようにマクロを組めば,やりたいことができるはずです.
- ユーザーにワークシート名を入力してもらう(ex. Data1)
- ユーザーに変数名を一つ入力してもらう(ex. V2)
- 指定されたワークシートから,入力された変数名が含まれる最も下のセルの行番号を取得(これをkey_ROWとする)
4.左上が(Row, Column) = (key_ROW, 1)に決まる
5. IsEmpty関数とDo Until文を使ってループさせることで,右下の(Row, Column)を取得
6. Range(Cells(左上),Cells(右下))をSummaryワークシートにコピーする
7. 最後にA1のファイル名をSummaryワークシートにコピーする
#マクロ
とりあえず動けばいいやのマクロが出来たのでそれを掲載.
今後細かいところを詰めるかもしれないし詰めないかもしれない.
Sub DynamicCopy()
' Worksheets
Dim data_ws, summary_ws As Worksheet
' For iteration
Dim i As Integer
' For searching data from data worksheet
Dim key_RNG As Range
Dim key_VAR As String
Dim key_ROW, key_COL As Integer
Dim firstAddress As String
Dim Right, Bottom As Integer
Dim Data_width, Data_length As Integer
' For copy data to summary worksheet
Dim place_ROW, place_COL As Integer
Dim DSname As String
DSname = InputBox("Please enter datasheet name.", "DSname", "")
Set data_ws = Worksheets(DSname)
Set summary_ws = Worksheets("Summary")
' Input "key" variable name from user.
key_VAR = InputBox("Please enter key variable.", "key_VAR", "")
If key_VAR = "" Then
MsgBox ("Please enter key variable name.")
End
End If
' First finding
Set key_RNG = data_ws.Cells.Find(What:=key_VAR)
If Not key_RNG Is Nothing Then
firstAddress = key_RNG.Address
Else
MsgBox (key_VAR + " is not found.")
End
End If
' Continue finding
key_ROW = key_RNG.Row
Do While True
Set key_RNG = data_ws.Cells.FindNext(key_RNG)
If key_RNG.Row > key_ROW Then
key_ROW = key_RNG.Row
End If
If key_RNG.Address = firstAddress Then Exit Do
Loop
key_COL = 1
' Find right index
' And define "Data width"
i = 1
Do Until IsEmpty(data_ws.Cells(key_ROW, i)) = True
i = i + 1
Loop
Right = i - 1
Data_width = Right - key_COL
' Find bottom index
' And define "Data length"
i = key_ROW
Do Until IsEmpty(data_ws.Cells(i, 1)) = True
i = i + 1
Loop
Bottom = i - 1
Data_length = Bottom - key_ROW
' Copy data
place_ROW = 4
place_COL = 3
summary_ws.Range(summary_ws.Cells(place_ROW, place_COL), summary_ws.Cells(place_ROW + Data_length, place_ROW + Data_width - 1)).Value = _
data_ws.Range(data_ws.Cells(key_ROW, key_COL), data_ws.Cells(Bottom, Right)).Value
' Copy dataname
summary_ws.Cells(1, place_COL).Value = data_ws.Cells(1, 1).Value
End Sub
#References
このマクロを作るにあたって,様々なWebサイトを参考にしました.ありがとうございます.
特に参考にしたものはこちら
条件に当てはまるセルを検索する(Find/FindNext/FindPreviousメソッド)