今日は閏日(leap day)です。
2024/02/29

目標

エクセルと同じフォルダにある複数のCSVに対し、自動でCSV毎にタブを生成し読み込む。
CSVファイル数が多いため、自動処理したい。数が少ないなら、手動がよい。
WinとMac環境に対応させる。

はじめに

　MacのVBAは面倒なことが多く起きる。ネット上の多くの情報はWindows用であり、知らずにMac環境でやろうとしてもエラーばかり。コードが悪いのか、環境が悪いのか、どこでエラーになってるのか、なんのエラーなのかわからないことが多く、とにかく、時間だけを消費することになったので、メモとして残す。

■MacのVBAの嫌なところ
①エディタのスクロールが滑らかでない
②エディタのカーソルがずれる（フォント幅のせい）
③パスのフォルダ記号がMacは/で、Winは\もしくは¥で、環境を吸収するコードが必要
④ファイル選択ウィンドウのGetOpenFilename関数で、拡張子を指定したり、複数ファイル選択ができない
⑤入力数値によっては書式が「通貨」になる

OSの判定

　OSによってVBAの挙動が異なる。そのため、OSを判別して、分岐処理をする必要がある。まず、セルに入力して、判別する方法が２つあり、結果を参照して、分岐処理をすればよい。

以下をセルに入力した際、表示される内容

入力１

=INFO("OSVERSION")

Windowsの例

Windows (64-bit) NT 6.02

Macの例

Macintosh (ARM) バージョン13.4.1 (c)（ビルド22F770820d）

入力２

=INFO("system")

Windowsの例

pcdos

Macの例

mac

これをVBAで自動化するなら、こんな感じ。

VBA

Sub ImportCSV()
  Range("A1").Value = "=INFO(""system"")"
  If Range("A1").Value = "mac" Then
    isMac = True
End Sub

別の方法として、
VBAでOSを判別するには、Application.OperatingSystemを使う。

VBA

Sub ImportCSV()
    Debug.print Application.OperatingSystem
    isMac = Application.OperatingSystem Like "*Mac*"
    Debug.print isMac
End Sub

Windowsの例

Windows (64-bit) NT 6.02
False

Macの例

Macintosh (ARM) バージョン13.4.1 (c)（ビルド22F770820d）
True

エクセルと同じフォルダにある複数のCSVを読み込んで、タブを作成し、流し込む

　CSV読み込みは、QueryTablesつかうのが、便利そうであったが、うまく動かすことができなかったので、確実に動きそうな、原始的な方法で読み込む。ただし、CSVの列数が決まっている必要がある。

エクセルVBA

Sub ImportCSV()
  'winとmacでフォルダのパスが / か \ で違うので、判定が必要
  Dim isMac As Boolean
  isMac = Application.OperatingSystem Like "*Mac*"

  Dim folderChar As String

  'Windowsの場合は /
  'Macの場合は \
  'バックスラッシュはWindowsでは¥(円記号)で表示される
  If isMac Then
    folderChar = "/"
  Else
    folderChar = "\"
    'folderChar = Chr(92)
  End If
  
    Dim Path As String
    Path = ThisWorkbook.Path
    
    Dim str As String
    str = Dir(Path + folderChar + "*.csv")   'str には最初のファイル名が入る
    
    Dim n As Integer
    n = 1  '開いたファイルの識別子(閉じるのに必要)
    Dim i As Integer
    i = 1 'エクセルに書き込む行番号
    
    Do While str <> ""
      'シートの追加
      'シート名はファイル名から拡張子を取り除いたもの
      Worksheets.Add After:=Sheets(Worksheets.Count)
      sheetName = Replace(str, ".csv", "")
      ActiveSheet.name = sheetName

      'CSVファイルを読み取りモードで開いて、エクセルに１行ずつコピー
      Open Path + folderChar + str For Input As #n
        Do While Not EOF(n)
            Input #n, d1, d2, d3
            'Worksheets(sheetName).Cells(i, 1).NumberFormatLocal = "G/標準"
            '7.9813 のように小数点以下４桁しかないと、通貨として認識される問題がある
            'csv書き出しの際に、少数点以下５桁は必要(エクセルの環境にもよる)
            Worksheets(sheetName).Cells(i, 1).Value = d1
            Worksheets(sheetName).Cells(i, 2).Value = d2
            Worksheets(sheetName).Cells(i, 3).Value = d3
            i = i + 1
        Loop
      Close #n
      n = n + 1
      i = 1
        
      '散布図グラフの挿入
      InsertSanpu (sheetName)
      
      str = Dir()       'str には２番目のファイル名が入る
    Loop
    
End Sub

'散布図の挿入
Sub InsertSanpu(name As String)
    Worksheets(name).Activate
    ActiveSheet.Shapes.AddChart2.Select
    ActiveChart.ChartType = xlXYScatterLinesNoMarkers
    ActiveChart.Axes(xlCategory, 1).HasTitle = True
    ActiveChart.Axes(xlCategory, 1).AxisTitle.Text = "Sec(秒)"
    ActiveChart.SetSourceData ActiveSheet.Range("A1").CurrentRegion
End Sub

csvの例

time,position,speed
0.00000 ,0.044203983,0.260908964
0.10000 ,0.383723065,0.493693214
0.20000 ,0.503404731,0.182618284
0.30000 ,0.938144851,0.065139821
0.40000 ,0.406058089,0.119077598
0.50000 ,0.554165928,0.955698656
0.60000 ,0.282639388,0.185422977
0.70000 ,0.958696069,0.907759672
0.80000 ,0.128357741,0.441615936
0.90000 ,0.616493446,0.491700641
1.00000 ,0.226033267,0.019804524

その他

拡張子が選べない＆複数ファイル選択できない問題はActionScriptで回避可能らしい。
でも、動かせませんでした。

参考サイト