エクセルVBA入門

はじめに

普段VBAはさわらないのですが、たまにエクセルの資料から値を抽出してJSONファイルつくりたいなぁと思うことがあります。

毎回やり方を忘れるので備忘録として。

目指すのは納品とかは考えずにあくまで自分の作業を楽にするためのやつです！

プロシージャ

プロシージャはたぶん関数みたいなやつです。（実行できる処理の単位？）

下記2つがあります。

• Subプロシージャ
• Functionプロシージャ

違いは戻り値が設定できるかどうかかと思います。（あんまわかってない）

とりあえず私は下記のように Function に細かい処理を書いて Sub で Function を呼び出すように実装してます。

Sub Test()
  Call ProcessA()
  Call ProcessB()
End Sub

Private Function ProcessA()
  'なんか処理
End Function

Private Function ProcessB()
  'なんか処理
End Function

変数

データ型

データ型は下記のようなものがあります。

参考：データ型の概要

データ型	説明
Boolean	True または False
Byte	バイト型（0~255）
Collection	連想配列
Currency	通貨型
Date	日付
Decimal	小数
Dictionary	連想配列
Double	小数
Integer	整数
Long	整数
LongLong	整数
LongPtr	整数（32ビットと64ビットシステムで変わる）
Object	オブジェクト型
Single	小数
String	文字列
String * 数字	固定長文字列
Variant	何でもいける
構造体（Typeで定義）	ユーザー定義型

いっぱいありますが Boolean, Integer, String, Collection だけで大体できます。

＊コメントでいただきましたが、Integer より Long を使用した方がいいようです。（参考）

変数宣言

変数宣言は Dim 変数名 As 型 のように行います。

宣言と代入は別々に書く必要があり下記のようになります。

オブジェクト型の代入は Set 変数名 = 値 のように書きます。

Dim flag As Boolean
flag = True

Dim num As Integer
num = 10

Dim str As String
str = "AAA"

Dim values As Collection
Set values = New Collection

型変換

数値を文字列に変換する場合などは下記のように色々用意されています。参考：データ型変換関数

Function	戻り値
CBool	Boolean
CByte	Byte
CCur	Currency
CDate	Date
CDbl	Double
CDec	Decimal
CInt	Integer
CLng	Long
CLngLng	LongLong
CLngPtr	LongPtr
CSng	Single
CStr	String
CVar	Variant

定数

下記のように定数宣言ができる

Const MAX_VALUE As Integer = 100

演算子

算術演算子

• +
• -
• *
• /
• ^（べき乗）
• ¥（商）
• Mod（余り）

比較演算子

• =（左辺と右辺が等しい）
• <>（左辺と右辺が異なる）
• <
• >
• <=
• >=

=と<>がよく間違えるので注意（==、!=じゃない）

論理演算子

• And
• Or
• Not

構文

繰り返し

For

For i = 1 To 10
  Debug.Print i '1~10出力
Next i

For i = 1 To 10 Step 3
  Debug.Print i '1,4,7,10出力
Next i

Do

Dim num As Integer

num = 0
Do While num < 10
  Debug.Print num '0~9出力
  num = num + 1
Loop

num = 0
Do
  Debug.Print num '0~9出力
  num = num + 1
Loop While num < 10

num = 0
Do Until num > 10
  Debug.Print num '0~10出力
  num = num + 1
Loop 

num = 0
Do
  Debug.Print num '0~10出力
  num = num + 1
Loop Until num > 10

num = 0
Do
  If num > 10 Then
    Exit Do
  End If
  Debug.Print num '0~10出力
  num = num + 1
Loop

条件分岐

If

Dim num As Integer
num = 0
If num > 0 Then
  Debug.Print "Big"
ElseIf num = 0 Then
  Debug.Print "Zero"
Else
  Debug.Print "Small"
End If

Select Case

switchみたいなやつ

Dim num As Integer
num = 0
Select Case num
Case 0
  Debug.Print "Zero"
Case 1
  Debug.Print "One"
Case Else
  Debug.Print "Other"
End Select

処理抜け

For文とかを途中で抜けるやつ

For i = 0 To 10
  If 0 = 5 Then
    Exit For
  End If
  Debug.Print i '0~4出力
Next i

他にも下記がある

• Exit Do
• Exit Sub
• Exit Function

With

これがよく忘れるけど使うとたぶん便利なやつ

オブジェクト変数の省略ができる。

Dim values As New Collection
With values
  .Add "A"
  .Add "B"
  .Add "C"
End With

Function

Function の書式は下記

Function 関数名(引数1 As 型, 引数2 As 型, ・・・) As 型
  関数名 = 値 '戻り値
End Function

呼び出し方は下記のように3パターンある。参考：Office TANAKA - VBAのステートメント[Call]

関数名 引数1, 引数2
Call 関数名(引数1, 引数2)
変数 = 関数名(引数1, 引数2)

引数

引数には値渡し（ByVal）と参照渡し（ByRef）があります。

指定しないこともできますが呼び出し方によって参照渡しになったりするようなので指定したほうが無難です。

'値渡し
Function ProcessA(ByVal num As Integer)
End Function

'参照渡し
Function ProcessB(ByRef num As Integer)
End Function

'これは危険
Function ProcessC(num As Integer)
End Function

戻り値

戻り値の設定は 関数名 = 値 のように設定します。

'呼び出し
Sub Test()
  Dim num As Integer
  num = ProcessA()
  Dim nums As Collection
  Set nums = ProcessB()
End Sub

'オブジェクト以外の場合
Function ProcessA() As Integer
  Dim num As Integer
  num = 100 + 10
  ProcessA = num
End Function

'オブジェクトの場合
Function ProcessB() As Collection
  Dim nums As New Collection
  nums.Add 100
  nums.Add 10
  Set ProcessB = nums 'Setが必要
End Function

文字列操作

文字列操作色々

長さ

Debug.Print Len("あいうえお") '5が出力される

抜き出し

Debug.Print Mid("あいうえお", 2, 3) 'いうえが出力される

Debug.Print  Left("あいうえお", 3) 'あいうが出力される

Debug.Print  Right("あいうえお", 3) 'うえおが出力される

結合

Debug.Print "あいう" & "えお" 'あいうえおが出力される

大文字・小文字変換

Debug.Print LCase("ABC") 'abcが出力される

Debug.Print UCase("abc") 'ABCが出力される

トリミング

Debug.Print LTrim(" あ い う ") 'あ い う が出力される

Debug.Print RTrim(" あ い う") ' あ い うが出力される

Debug.Print Trim(" あ い う ") 'あいうが出力される

置換

Debug.Print Replace("あいうい", "い", "A") 'あAうAが出力される

Debug.Print Replace(Cells(1, 1).Value, vbLf, "") ' A1セルの値の改行を削除した値が出力される

検索

Debug.Print InStr("あいうえお", "い") '2が出力される

Collection

Collection はキーでアクセスする連想配列と添字でアクセスする配列のように使うことができます。

VBAには配列もあるようですが最初に要素数を決める必要があるので要素数が変更される場合は ReDim で再定義必要があるので少々使いづらいです...

なので全部 Collection を使っちゃえばいいと思います（処理速度とか気にするなら配列のがいいかもしれません）

初期化

Collection の初期化は下記のように2パターン書けます。

Dim values As Collection
Set values = New Collection

Dim values As New Collection

追加・削除

連想配列のように使う場合

Dim values As New Collection

'追加
values.Add "田中", "name"
values.Add 29, "age"

'削除
values.Remove "name"

配列のように使う場合

Dim values As New Collection

'追加
values.Add "田中"
values.Add "佐藤"

'削除
values.Remove 1 'Indexは0ではなく1から
'田中が削除される

アクセス

連想配列のように使う場合

Dim values As New Collection
values.Add "田中", "name"
values.Add 29, "age"

Debug.Print values("name")

配列のように使う場合

Dim values As New Collection
values.Add "田中"
values.Add "佐藤"

Debug.Print values(1) 'Indexは0ではなく1から
'田中が出力される

要素数分処理

For Each文で要素数分処理ができます。

Dim values As New Collection
values.Add "田中"
values.Add "佐藤"

For Each value In Values
  Debug.Print value
Next value

列挙型

Enum Value
  Value1
  Value2
End Enum

Debug.Print Value.Value1 '0が出力される

こうやると値が設定できる

Enum Value
  Value1 = 1
  Value2 = 2
End Enum

構造体（ユーザー定義型）

宣言

Type Person
  name As String
  age As Integer
End Type

初期化

Dim p As Person
p.name = "田中"
p.age = 29

引数に設定

'ByValにはできない
Function ProcessA(ByRef p As Person)
  Debug.Print p.name
  Debug.Print p.age
End Function

戻り値に設定

Function ProcessA() As Person
  Dim p As Person
  p.name = "田中"
  p.age = 29
  ProcessA = p
End Function

Collectionをもたせる

Type Person
  name As String
  age As Integer
  children As Collection
End Type

Function ProcessA() As Person
  Dim p As Person
  p.name = "田中"
  p.age = 29
  Set p.children = New Collection
  p.children.Add "太郎"
  p.children.Add "次郎"
  ProcessA = p
End Function

はまったポイント

• 処理実行時にSubの上にないと実行できなかった
• Privateをつけないとエラーになる
• 引数で値渡しはできない
• Collectionには追加できない

なので下記のような書き方にしました。

Private Type Person
  name As String
  age As Integer
End Type

Sub Test()
  Dim p As Person
  p.name = "田中"
  p.age = 29
  Call ProcessA(p)
End Sub

Function ProcessA(ByRef p As Person)
  Debug.Print p.name
  Debug.Print p.age
End Function

Collectionにはユーザー定義型は追加できないらしいのであきらめました

Cellの指定

単一セル

Cells(1, 1).Value 'A1セルの値取得
Range("A1").Value 'A1セルの値取得

結合セル

A1~B3セルの合計6個のセルを結合していてセルに「あいう」と値が入っている場合

With Range("A1").MergeArea
  Debug.Print .Rows.Count '2が出力される
  Debug.Print .Columns.Count '3が出力される
End With
Debug.Print Range("A1").MergeArea(1, 1).Value 'あいうが出力される

Sheetの指定

Cells(1, 1).Value でセルの値を取る場合は ActiveSheet.Cells(1, 1).Value のようにシートを指定したほうがいい。

• ActiveSheet '現在アクティブなシート
• Worksheets(1) '1枚目のシート
• Worksheets("Sheet1") 'Sheet1という名前のシート

シートの数分処理

For Each sheet In Worksheets
  sheet.Activate '順番にシートをアクティブにする
Next sheet

実践

実践としてJSONファイルを出力するマクロを作ってみたいと思います。
注意事項としてMacの場合はエクセルのエディタがめっちゃ遅いので作成は他のエディタでやったほうがいいと思います。（わたしはSublime Textでやりました）Macでは基本的に参照設定いじったりしてから行う CreateObject は使えないので別の手段を探した方がいいです。

下記のようなエクセルからJSONファイルを出力します。

ほしいJSON

[
    {
        "num":"1",
        "name":"田中",
        "age":"29"
    },
    {
        "num":"2",
        "name":"佐藤",
        "age":"32"
    },

    (中略)

    {
        "num":"10",
        "name":"向井",
        "age":"23"
    }
]

Private Const JSON_KEY_NUM As String = "num"
Private Const JSON_KEY_NAME As String = "name"
Private Const JSON_KEY_AGE As String = "age"

Sub OutPutJson()
  Worksheets(1).Activate
  Call WriteJSON(GetValues())
End Sub

Private Function GetValue(ByVal row As Integer) As Collection
  Dim value As New Collection
  With value
    .Add ActiveSheet.Cells(row, 1).value, JSON_KEY_NUM
    .Add ActiveSheet.Cells(row, 2).value, JSON_KEY_NAME
    .Add ActiveSheet.Cells(row, 3).value, JSON_KEY_AGE
  End With
  Set GetValue = value
End Function

Private Function GetValues() As Collection
  Dim values As New Collection
  Dim row As Integer
  row = 2
  Do
    If ActiveSheet.Cells(row, 1).value = "" Then
      Exit Do
    End If
    values.Add GetValue(row)
    row = row + 1
  Loop
  Set GetValues = values
End Function

Private Function WriteJSON(ByVal values As Collection)
  Dim text As String
  Dim isFirst As Boolean
  isFirst = True
  text = "[" & vbLf

  For Each value In values
    '1行目か確認して2行目以降の場合は行頭に","を挿入
    If isFirst = True Then
      isFirst = False
    Else
      text = text & "," & vbLf
    End If

    '行の開始タグを挿入
    text = text & vbTab & "{" & vbLf
    text = text & vbTab & vbTab & """" & JSON_KEY_NUM & """" & ":" & """" & value(JSON_KEY_NUM) & """" & "," & vbLf
    text = text & vbTab & vbTab & """" & JSON_KEY_NAME & """" & ":" & """" & value(JSON_KEY_NAME) & """" & "," & vbLf
    text = text & vbTab & vbTab & """" & JSON_KEY_AGE & """" & ":" & """" & value(JSON_KEY_AGE) & """" & vbLf

    '行の閉じタグを挿入
    text = text & vbTab & "}"
  Next value

  'JSON終了タグ
  text = text & vbLf
  text = text & "]" & vbLf

  'ファイル保存
  Dim filePath As String
  filePath = ThisWorkbook.Path & "/test.json"
  Open filePath For Binary Access Write As #1
  PutUTF8String 1, text
  Close #1
End Function

' 文字列をUTF-8でPutする
' 引数:
'   fileNum: Openステートメントで指定したファイル番号
'   str: 出力する文字列
' 備考:
'   ファイルは Open ? For Binary で開かれていること
Sub PutUTF8String(ByVal fileNum As Integer, ByRef str As String)
    Dim byteUTF8() As Byte  ' 文字をUTF-8エンコードしたものを格納する
    Dim c, d As String      ' 変換する文字 (dはサロゲートペア下位用)
    Dim i, w, v As Integer  ' ループカウンタと文字コード取得用
    Dim u As Long           ' Unicode化した文字コード

    ' For ? Next ではなく Do ? Loop なのはループ中でカウンタを飛ばすため
    i = 1
    Do While i <= Len(str)
        c = Mid(str, i, 1)
        w = AscW(c)

        If w >= &HD800 And w < &HDBFF Then
            ' サロゲートペア上位の場合はカウンタを進めて下位も取得する
            ' ToDo: サロゲートペア下位の値チェック
            i = i + 1
            d = Mid(str, i, 1)
            v = AscW(d)

            ' サロゲートペアのデコード
            u = &H10000 + ((w And &HFFFF&) - &HD800&) * &H400& + ((v And &HFFFF&) - &HDC00&)
        Else
            ' 符号ありで表現された文字コードを符号なし表現へ
            u = w And &HFFFF&
        End If

        byteUTF8() = Unicode2UTF8(u)

        Put #fileNum, , byteUTF8

        i = i + 1
    Loop
End Sub

' UnicodeをUTF-8にエンコードする
' 引数:
'   u: Unicode文字コード
' 戻値:
'   UTF-8エンコードした文字のByte配列
Function Unicode2UTF8(u As Long) As Byte()
    Dim byteUTF8() As Byte

    Select Case u
        Case Is < &H80&
            ReDim byteUTF8(0)
            byteUTF8(0) = CByte(u)
        Case Is < &H800&
            ReDim byteUTF8(1)
            byteUTF8(0) = CByte(((u And &H7F0&) / 64) + 192)
            byteUTF8(1) = CByte((u And &H3F&) + 128)
        Case Is < &H10000
            ReDim byteUTF8(2)
            byteUTF8(0) = CByte(((u And &HF000&) / 4096) + 224)
            byteUTF8(1) = CByte(((u And &HFC0&) / 64) + 128)
            byteUTF8(2) = CByte((u And &H3F&) + 128)
        Case Is < &H200000
            ReDim byteUTF8(3)
            byteUTF8(0) = CByte(((u And &H1C0000) / 262144) + 240)
            byteUTF8(1) = CByte(((u And &H3F000) / 4096) + 128)
            byteUTF8(2) = CByte(((u And &HFC0&) / 64) + 128)
            byteUTF8(3) = CByte((u And &H3F&) + 128)
        Case Else
            ' UTF-8で5バイト以上になる範囲はエラー代わりに1バイトの0を返す
            ReDim byteUTF8(0)
            byteUTF8(0) = 0
    End Select

    Unicode2UTF8 = byteUTF8()
End Function

JSON の書き出しと UTF8 への変換は下記参考

• Office 2016 for MacのVBAでUTF-8テキストファイルを出力する
• ExcelのリストをJSONに変換するマクロ

上記のやつを作成したらエクセルの Visual Basic Editor に貼り付けて実行します。

このマクロをすべてのエクセルで有効にしたい場合は下記参考に PERSONAL.xlsb に保存します。

参考：エクセルのPERSONAL.xlsb にマクロの追加方法

さいごに

これでエクセルから値を取得してJSONファイルを出力できるようになりました

ガンガンJSONつくりましょう

納品とか保守とか考えてちゃんと作りたい場合は下記記事などがとても参考になると思います。

• 昨日までJavaJavaしてた人がいきなりExcelのVBAを実装する羽目になったときのためのメモ
• Excel VBAコーディング ガイドライン案

この前、「レスポンス」というシート名のやつから値を取得しようとしたら何回やってもデータ数が合わずに数時間悩んでいたら非表示シートに「レスポンス」というシートがあり、表示されているシートは「レスポンス　」というスペースありのやつということがありました

シート名の指定には気をつけましょう！！

参考文献

• データ型の概要
• データ型変換関数
• Office TANAKA - VBAのステートメント[Call]
• Office 2016 for MacのVBAでUTF-8テキストファイルを出力する
• ExcelのリストをJSONに変換するマクロ
• エクセルのPERSONAL.xlsb にマクロの追加方法
• 昨日までJavaJavaしてた人がいきなりExcelのVBAを実装する羽目になったときのためのメモ
• Excel VBAコーディング ガイドライン案