csvデータをExcel取り込みするマクロ

今回は電気化学測定装置から吐き出されるCV（サイクリックボルタモグラム）のデータを、簡単に処理するために組んだマクロをアップします。

仕様もどき
実際のコード
一言メモ

仕様もどき

ちゃんと仕様を考えていたわけではありませんが、だいたいのポイントはこんな感じです。

生データはファイル名「02 CV」から始まるcsv
Excelで開くと上から10行目くらいまで基本情報
13行目くらいから１サイクル目が始まる
サイクル毎の諸情報・予備測定・本測定がある
測定データは５サイクル分
必要なのは本測定データ
1サイクル分のデータ量が1600点程度
マクロで動かすのは実行ファイルと生データファイルのみ
マクロ実行ファイルと同階層に生データファイル
マクロ実行ファイルに「貼り付け先」シートを用意
データの単位操作やグラフ加工は別シートにテンプレを用意

実際のコード

以下、実際に使っていたコードです。ちょっと苦労したのが各サイクルの「本測定」の判別ですね。Address、Findを使ってループする形で解決しました。

Sub CVDataCopipe()
    Application.ScreenUpdating = False
    
    'ファイル開く
    Dim PName As String 'このブックのパス
    PName = ThisWorkbook.Path & "\"
    
    Dim FName As String '生データのブック
    FName = Dir(PName & "02 CV*.csv")
    Workbooks.Open Filename:=PName & FName

    'シート１をアクティブにしていないとNG
    Dim myRange As Range
    Dim myAdrs As String
    Dim myData As Range
              'myData は本測定から
    Dim c As Long
    
    Set myRange = ActiveSheet.Range("D:D").Find("本測定")
    myAdrs = myRange.Address
    
    Do
        ActiveSheet.Activate
        Set myData = myRange.Offset(13, -2)
        myData.CurrentRegion.Offset(1, 1).Select
        Selection.Resize(Selection.Rows.Count - 1, Selection.Columns.Count - 3).Copy
        c = ThisWorkbook.Worksheets("貼り付け先").Cells(2, Columns.Count).End(xlToLeft).Column + 1
        ThisWorkbook.Worksheets("貼り付け先").Cells(2, c).PasteSpecial Paste:=xlPasteValues
        
        Set myRange = ActiveSheet.Range("D:D").FindNext(myRange)
        
    Loop Until myRange.Address = myAdrs
    
    ActiveSheet.Range("A1").Copy  'クリップボードのデータを小さくする
    ActiveWorkbook.Close savechanges:=False  '変更を保存しないでCSVを閉じる


End Sub

Sub CVDataCopipe()

Application.ScreenUpdating = False

'ファイル開く

Dim PName As String 'このブックのパス

PName = ThisWorkbook.Path & "\"

Dim FName As String '生データのブック

FName = Dir(PName & "02 CV*.csv")

Workbooks.Open Filename:=PName & FName

'シート１をアクティブにしていないとNG

Dim myRange As Range

Dim myAdrs As String

Dim myData As Range

'myData は本測定から

Dim c As Long

Set myRange = ActiveSheet.Range("D:D").Find("本測定")

myAdrs = myRange.Address

ActiveSheet.Activate

Set myData = myRange.Offset(13, -2)

myData.CurrentRegion.Offset(1, 1).Select

Selection.Resize(Selection.Rows.Count - 1, Selection.Columns.Count - 3).Copy

c = ThisWorkbook.Worksheets("貼り付け先").Cells(2, Columns.Count).End(xlToLeft).Column + 1

ThisWorkbook.Worksheets("貼り付け先").Cells(2, c).PasteSpecial Paste:=xlPasteValues

Set myRange = ActiveSheet.Range("D:D").FindNext(myRange)

Loop Until myRange.Address = myAdrs

ActiveSheet.Range("A1").Copy 'クリップボードのデータを小さくする

ActiveWorkbook.Close savechanges:=False '変更を保存しないでCSVを閉じる

End Sub

一言メモ

今見ると相当酷い。アクティブをアクティブにするという謎（笑）でも、こんな粗雑なプログラムでもとても重要な働きをしていたんです。必要なところが動けばOKです。
材料系の研究をしている方ってまだまだデータ処理を手作業でえいやっと処理している人が多いイメージです。これからやるならPythonでしょうかね。おばちゃんはまだマクロで戦ってますよー。