エクセルVBA入門

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

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

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

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

下記2つがあります。

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

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

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

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

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

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

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

参考：[データ型の概要](https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/data-type-summary)

| データ型 | 説明 |
| --- | --- |
| 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` だけで大体できます。 

＊[コメント](https://qiita.com/am10/items/ad786e98446264201f7e#comment-5084d45cbe0cfae592a2)でいただきましたが、`Integer` より `Long` を使用した方がいいようです。（[参考](https://qiita.com/mima_ita/items/8b0eec3b5a81f168822d#integer%E5%9E%8B%E3%81%AE%E4%BD%BF%E7%94%A8%E3%81%AF%E9%81%BF%E3%81%91%E3%82%8B)）

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

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

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

```vb
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
```

## 型変換
数値を文字列に変換する場合などは下記のように色々用意されています。参考：[データ型変換関数](https://docs.microsoft.com/ja-jp/office/vba/language/concepts/getting-started/type-conversion-functions)

| 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 |

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

```vb
Const MAX_VALUE As Integer = 100
```

# 演算子
## 算術演算子
* +
* -
* *
* /
* ^（べき乗）
* ¥（商）
* Mod（余り）

## 比較演算子
* =（左辺と右辺が等しい）
* <>（左辺と右辺が異なる）
* <
* \>
* <=
* \>=

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

## 論理演算子
* And
* Or
* Not

# 構文
## 繰り返し
### For
```vb
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
```vb
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
```vb
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みたいなやつ

```vb
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文とかを途中で抜けるやつ

```vb
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
これがよく忘れるけど使うとたぶん便利なやつ

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

```vb
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]](http://officetanaka.net/excel/vba/statement/Call.htm)

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

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

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

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

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

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

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

```vb
'呼び出し
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
```

# 文字列操作
文字列操作色々

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

## 抜き出し
```vb
Debug.Print Mid("あいうえお", 2, 3) 'いうえが出力される

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

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

## 結合
```vb
Debug.Print "あいう" & "えお" 'あいうえおが出力される
```

## 大文字・小文字変換
```vb
Debug.Print LCase("ABC") 'abcが出力される

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

## トリミング
```vb
Debug.Print LTrim(" あ い う ") 'あ い う が出力される

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

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

## 置換
```vb
Debug.Print Replace("あいうい", "い", "A") 'あAうAが出力される

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

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

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

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

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

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

```vb
Dim values As Collection
Set values = New Collection

Dim values As New Collection
```

## 追加・削除
連想配列のように使う場合

```vb
Dim values As New Collection

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

'削除
values.Remove "name"
```

配列のように使う場合

```vb
Dim values As New Collection

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

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

## アクセス
連想配列のように使う場合

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

Debug.Print values("name")
```

配列のように使う場合

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

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

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

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

For Each value In Values
  Debug.Print value
Next value
```

# 列挙型

```vb
Enum Value
  Value1
  Value2
End Enum

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

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

```vb
Enum Value
  Value1 = 1
  Value2 = 2
End Enum
```

# 構造体（ユーザー定義型）
## 宣言
```vb
Type Person
  name As String
  age As Integer
End Type
```

## 初期化
```vb
Dim p As Person
p.name = "田中"
p.age = 29
```

## 引数に設定
```vb
'ByValにはできない
Function ProcessA(ByRef p As Person)
  Debug.Print p.name
  Debug.Print p.age
End Function
```

## 戻り値に設定
```vb
Function ProcessA() As Person
  Dim p As Person
  p.name = "田中"
  p.age = 29
  ProcessA = p
End Function
```

## Collectionをもたせる
```vb
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には追加できない

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

```vb
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の指定
## 単一セル
```vb
Cells(1, 1).Value 'A1セルの値取得
Range("A1").Value 'A1セルの値取得
```

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

```vb
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という名前のシート

シートの数分処理

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

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

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

<img width="300" alt="excel" src="https://user-images.githubusercontent.com/34936885/75984470-ca466700-5f2d-11ea-9e60-779b0f86feef.png">

ほしいJSON

```JSON
[
	{
		"num":"1",
		"name":"田中",
		"age":"29"
	},
	{
		"num":"2",
		"name":"佐藤",
		"age":"32"
	},
	
	(中略)
	
	{
		"num":"10",
		"name":"向井",
		"age":"23"
	}
]
```


```vb
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テキストファイルを出力する](https://qiita.com/Nebutan/items/a70ad944c273365249be)
* [ExcelのリストをJSONに変換するマクロ](https://32877.xii.jp/view/337)

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

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

参考：[エクセルのPERSONAL.xlsb にマクロの追加方法](https://qiita.com/hhhkt/items/26ed87bd69cc47d33b0c)

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

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

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

* [昨日までJavaJavaしてた人がいきなりExcelのVBAを実装する羽目になったときのためのメモ](https://qiita.com/opengl-8080/items/5bd8ae7fe95f5c31dfc3)
* [Excel VBAコーディング ガイドライン案](https://qiita.com/mima_ita/items/8b0eec3b5a81f168822d)

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

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

# 参考文献
* [データ型の概要](https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/data-type-summary)
* [データ型変換関数](https://docs.microsoft.com/ja-jp/office/vba/language/concepts/getting-started/type-conversion-functions)
* [Office TANAKA - VBAのステートメント[Call]](http://officetanaka.net/excel/vba/statement/Call.htm)
* [Office 2016 for MacのVBAでUTF-8テキストファイルを出力する](https://qiita.com/Nebutan/items/a70ad944c273365249be)
* [ExcelのリストをJSONに変換するマクロ](https://32877.xii.jp/view/337)
* [エクセルのPERSONAL.xlsb にマクロの追加方法](https://qiita.com/hhhkt/items/26ed87bd69cc47d33b0c)
* [昨日までJavaJavaしてた人がいきなりExcelのVBAを実装する羽目になったときのためのメモ](https://qiita.com/opengl-8080/items/5bd8ae7fe95f5c31dfc3)
* [Excel VBAコーディング ガイドライン案](https://qiita.com/mima_ita/items/8b0eec3b5a81f168822d)