選択解除するショートカット

エクスプローラで選択されているファイルの選択解除するショートカット。

Ctrl+Space

以上。

パスのコピー(Windows10)

ファイルやフォルダを選択してShiftを押しながら右クリック。

フルパスが取得できる。パスはダブルクォーテーションで囲まれている。複数選択可。

以上。

フォルダを開く

どれもフォルダを開く処理。エラー処理を忘れないこと。

ThisWorkbook.FollowHyperlink folderPath

CreateObject("WScript.Shell").Run folderPath

shell "explorer " & folderPath, vbNormalFocus

' ファイルを選択した状態でフォルダを開く。フルパスであることに注意。
shell "explorer /select, " & fullPath, vbNormalFocus

フルパスからフォルダパスを取得する１例。

Sub フォルダパスを取得する()
    
    Dim fullPath As String
    fullPath = ThisWorkbook.FullName 'テスト用
    
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim folderPath As String
    folderPath = FSO.getParentFolderName(fullPath)
    
    'shell "explorer " & folderPath, vbNormalFocus ' フォルダを開く
    
End Sub

フォルダ有無の確認用。

If Dir(folderPath, vbDirectory) = "" Then
    ' フォルダが存在しない
Else
    ' OK
End If


If fso.FolderExists(folderPath) = True Then
    'OK
Else
    'フォルダが存在しない
End If

以上。

ファイルのプロパティ取得

GetDetailsOf。作成日付や更新日付、アルバムやアーティスト、ビットレート等々のプロパティ情報を取得する。

'参照設定
'Microsoft Shell Controls And Automation

Sub プロパティ取得()
    
    Dim fso As Object, file As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Set file = fso.GetFile(ThisWorkbook.FullName) '対象ファイルを指定
    
    Dim shell, folder
    Set shell = New Shell32.shell
    Set folder = shell.Namespace(file.ParentFolder.Path)
    
    Cells.Clear
    
    Dim i As Long
    For i = 0 To 500
        Cells(i + 1, 1).Value = i
        Cells(i + 1, 2).Value = folder.GetDetailsOf("", i) 'プロパティ名
        Cells(i + 1, 3).Value = folder.GetDetailsOf(folder.ParseName(file.Name), i) '内容
    Next
    
    Set folder = Nothing
    Set shell = Nothing
    
End Sub

プロパティ名を取得する箇所はNothingでも可。

= folder.GetDetailsOf("", i) 'プロパティ名
= folder.GetDetailsOf(Nothing, i) 'プロパティ名

OSやバージョンによって実行結果が違うので注意！
自分の環境の実行結果をそのまま載せておきますが、あてにしないこと。

Win7	プロパティ名	Win10	プロパティ名
0	名前	0	名前
1	サイズ	1	サイズ
2	項目の種類	2	項目の種類
3	更新日時	3	更新日時
4	作成日時	4	作成日時
5	アクセス日時	5	アクセス日時
6	属性	6	属性
7	オフラインの状態	7	オフラインの状態
8	オフラインで利用可能	8	利用可能性
9	認識された種類	9	認識された種類
10	所有者	10	所有者
11	分類	11	分類
12	撮影日時	12	撮影日時
13	参加アーティスト	13	参加アーティスト
14	アルバム	14	アルバム
15	年	15	年
16	ジャンル	16	ジャンル
17	指揮者	17	指揮者
18	タグ	18	タグ
19	評価	19	評価
20	作成者	20	作成者
21	タイトル	21	タイトル
22	件名	22	件名
23	分類項目	23	分類項目
24	コメント	24	コメント
25	著作権	25	著作権
26	トラック番号	26	トラック番号
27	長さ	27	長さ
28	ビット レート	28	ビット レート
29	保護	29	保護
30	カメラのモデル	30	カメラのモデル
31	大きさ	31	大きさ
32	カメラの製造元	32	カメラの製造元
33	会社	33	会社
34	ファイルの説明	34	ファイルの説明
35	プログラム名	35	マスター キーワード
36	継続時間	36	マスター キーワード
37	オンライン	37
38	再帰	38
39	場所	39
40	任意出席者アドレス	40
41	任意出席者	41
42	開催者住所	42	プログラム名
43	開催者名	43	継続時間
44	アラーム時刻	44	オンライン
45	必須出席者アドレス	45	再帰
46	必須出席者	46	場所
47	リソース	47	任意出席者アドレス
48	会議の状態	48	任意出席者
49	空き時間情報	49	開催者住所
50	合計サイズ	50	開催者名
51	アカウント名	51	アラーム時刻
52	進捗状況	52	必須出席者アドレス
53	コンピューター	53	必須出席者
54	記念日	54	リソース
55	秘書の名前	55	会議の状態
56	秘書の電話	56	空き時間情報
57	誕生日	57	合計サイズ
58	住所 (会社)	58	アカウント名
59	市 (会社)	59
60	国/地域 (会社)	60	進捗状況
61	私書箱 (会社)	61	コンピューター
62	郵便番号 (会社)	62	記念日
63	都道府県 (会社)	63	秘書の名前
64	番地 (会社)	64	秘書の電話
65	FAX 番号 (会社)	65	誕生日
66	会社のホーム ページ	66	住所 (会社)
67	会社電話	67	市 (会社)
68	コールバック番号	68	国/地域 (会社)
69	自動車電話	69	私書箱 (会社)
70	子供	70	郵便番号 (会社)
71	会社代表電話	71	都道府県 (会社)
72	部署	72	番地 (会社)
73	電子メール アドレス	73	FAX 番号 (会社)
74	電子メール2	74	会社のホーム ページ
75	電子メール3	75	会社電話
76	電子メールの一覧	76	コールバック番号
77	電子メール表示名	77	自動車電話
78	表題2	78	子供
79	名	79	会社代表電話
80	氏名	80	部署
81	性別	81	電子メール アドレス
82	名2	82	電子メール2
83	趣味	83	電子メール3
84	住所 (自宅)	84	電子メールの一覧
85	市 (自宅)	85	電子メール表示名
86	国/地域 (自宅)	86	表題2
87	私書箱 (自宅)	87	名
88	郵便番号 (自宅)	88	氏名
89	都道府県 (自宅)	89	性別
90	番地 (自宅)	90	名2
91	自宅 FAX	91	趣味
92	自宅電話	92	住所 (自宅)
93	IM アドレス	93	市 (自宅)
94	イニシャル	94	国/地域 (自宅)
95	役職	95	私書箱 (自宅)
96	ラベル	96	郵便番号 (自宅)
97	姓	97	都道府県 (自宅)
98	住所 (郵送先)	98	番地 (自宅)
99	ミドル ネーム	99	自宅 FAX
100	携帯電話	100	自宅電話
101	ニックネーム	101	IM アドレス
102	勤務先所在地	102	イニシャル
103	住所 (その他)	103	役職
104	ほかの市区町村	104	ラベル
105	他の国/地域	105	姓
106	他の私書箱	106	住所 (郵送先)
107	他の郵便番号	107	ミドル ネーム
108	他の都道府県	108	携帯電話
109	他の番地	109	ニックネーム
110	ポケットベル	110	勤務先所在地
111	肩書き	111	住所 (その他)
112	市区町村 (郵送先)	112	ほかの市区町村
113	国/地域	113	他の国/地域
114	私書箱 (郵送先)	114	他の私書箱
115	郵便番号 (郵送先)	115	他の郵便番号
116	都道府県	116	他の都道府県
117	番地 (郵送先)	117	他の番地
118	プライマリ電子メール	118	ポケットベル
119	通常の電話	119	肩書き
120	職業	120	市区町村 (郵送先)
121	配偶者	121	国/地域
122	サフィックス	122	私書箱 (郵送先)
123	TTY/TTD 電話	123	郵便番号 (郵送先)
124	テレックス	124	都道府県
125	Web ページ	125	番地 (郵送先)
126	内容の状態	126	プライマリ電子メール
127	内容の種類	127	通常の電話
128	取得日時	128	職業
129	アーカイブ日時	129	配偶者
130	完了日	130	サフィックス
131	デバイス カテゴリ	131	TTY/TTD 電話
132	接続済み	132	テレックス
133	探索方法	133	Web ページ
134	フレンドリ名	134	内容の状態
135	ローカル コンピューター	135	内容の種類
136	製造元	136	取得日時
137	モデル	137	アーカイブ日時
138	ペアリング済み	138	完了日
139	クラス	139	デバイス カテゴリ
140	状態	140	接続済み
141	クライアント ID	141	探索方法
142	貢献者	142	フレンドリ名
143	コンテンツの作成日時	143	ローカル コンピューター
144	前回印刷日	144	製造元
145	前回保存日時	145	モデル
146	事業部	146	ペアリング済み
147	ドキュメント ID	147	クラス
148	ページ数	148	状態
149	スライド	149	状態
150	総編集時間	150	クライアント ID
151	単語数	151	共同作成者
152	期限	152	コンテンツの作成日時
153	終了日	153	前回印刷日
154	ファイル数	154	前回保存日時
155	ファイル名	155	事業部
156	ファイル バージョン	156	ドキュメント ID
157	フラグの色	157	ページ数
158	フラグの状態	158	スライド
159	空き領域	159	総編集時間
160	ビットの深さ	160	単語数
161	水平方向の解像度	161	期限
162	幅	162	終了日
163	垂直方向の解像度	163	ファイル数
164	高さ	164	ファイル拡張子
165	重要度	165	ファイル名
166	添付	166	ファイル バージョン
167	削除	167	フラグの色
168	暗号化の状態	168	フラグの状態
169	フラグの有無	169	空き領域
170	終了済	170
171	未完了	171
172	開封の状態	172	グループ
173	共有	173	共有の種類
174	製作者	174	ビットの深さ
175	日付時刻	175	水平方向の解像度
176	フォルダー名	176	幅
177	フォルダーのパス	177	垂直方向の解像度
178	フォルダー	178	高さ
179	参加者	179	重要度
180	パス	180	添付
181	場所ごと	181	削除
182	種類	182	暗号化の状態
183	連絡先の名	183	フラグの有無
184	履歴の種類	184	終了済
185	言語	185	未完了
186	最終表示日	186	開封の状態
187	説明	187	共有
188	リンクの状態	188	製作者
189	リンク先	189	日付時刻
190	URL	190	フォルダー名
191	メディアの作成日時	191	フォルダーのパス
192	リリース日	192	フォルダー
193	エンコード方式	193	参加者
194	プロデューサー	194	パス
195	発行元	195	場所ごと
196	サブタイトル	196	種類
197	ユーザー Web URL	197	連絡先の名
198	作者	198	履歴の種類
199	添付ファイル	199	言語
200	BCC アドレス	200	最終表示日
201	BCC	201	説明
202	CC アドレス	202	リンクの状態
203	CC	203	リンク先
204	会話 ID	204	URL
205	受信日時	205
206	送信日時	206
207	送信元アドレス	207
208	差出人	208	メディアの作成日時
209	添付ファイルの有無	209	リリース日
210	送信者アドレス	210	エンコード方式
211	送信者名	211	エピソード番号
212	ストア	212	プロデューサー
213	送信先アドレス	213	発行元
214	To do タイトル	214	シーズン番号
215	宛先	215	サブタイトル
216	経費情報	216	ユーザー Web URL
217	アルバムのアーティスト	217	作者
218	アルバム ID	218
219	ビート数/分	219	添付ファイル
220	作曲者	220	BCC アドレス
221	イニシャル キー	221	BCC
222	コンパイルの一部	222	CC アドレス
223	雰囲気	223	CC
224	セットのパート	224	会話 ID
225	期間	225	受信日時
226	色	226	送信日時
227	保護者による制限	227	送信元アドレス
228	保護者による制限の理由	228	差出人
229	使用領域	229	添付ファイルの有無
230	EXIF バージョン	230	送信者アドレス
231	イベント	231	送信者名
232	露出補正	232	ストア
233	露出プログラム	233	送信先アドレス
234	露出時間	234	To do タイトル
235	絞り値	235	宛先
236	フラッシュ モード	236	経費情報
237	焦点距離	237	アルバムのアーティスト
238	35mm 焦点距離	238	アルバム アーティストで並べ替え
239	ISO 速度	239	アルバム ID
240	レンズ メーカー	240	アルバムで並べ替え
241	レンズ モデル	241	参加アーティストで並べ替え
242	光源	242	ビート数/分
243	最大絞り	243	作曲者
244	測光モード	244	作曲者で並べ替え
245	向き	245	ディスク
246	人物	246	イニシャル キー
247	プログラムのモード	247	コンパイルの一部
248	彩度	248	雰囲気
249	対象の距離	249	セットのパート
250	ホワイト バランス	250	期間
251	優先度	251	色
252	プロジェクト	252	保護者による制限
253	チャンネル番号	253	保護者による制限の理由
254	この回のタイトル	254	使用領域
255	字幕	255	EXIF バージョン
256	再放映	256	イベント
257	SAP	257	露出補正
258	放送日	258	露出プログラム
259	プログラムの説明	259	露出時間
260	記録時間	260	絞り値
261	ステーション コール サイン	261	フラッシュ モード
262	局名	262	焦点距離
263	概要	263	35mm 焦点距離
264	抜粋	264	ISO 速度
265	自動要約	265	レンズ メーカー
266	検索のランキング	266	レンズ モデル
267	秘密度	267	光源
268	共有ユーザー	268	最大絞り
269	共有状態	269	測光モード
270	製品名	270	向き
271	製品バージョン	271	人物
272	サポートのリンク	272	プログラムのモード
273	ソース	273	彩度
274	開始日	274	対象の距離
275	課金情報	275	ホワイト バランス
276	完了	276	優先度
277	仕事の所有者	277	プロジェクト
278	総ファイル サイズ	278	チャンネル番号
279	商標	279	この回のタイトル
280	ビデオ圧縮	280	字幕
281	ディレクター	281	再放映
282	データ速度	282	SAP
283	フレーム高	283	放送日
284	フレーム率	284	プログラムの説明
285	フレーム幅	285	記録時間
286	総ビット レート	286	ステーション コール サイン
287		287	局名
288		288	概要
289		289	抜粋
290		290	自動要約
291		291	関連度
292		292	ファイルの所有権
293		293	秘密度
294		294	共有ユーザー
295		295	共有状態
296		296
297		297	製品名
298		298	製品バージョン
299		299	サポートのリンク
300		300	ソース
301		301	開始日
302		302	共有中
303		303	可用性の状態
304		304	状態
305		305	課金情報
306		306	完了
307		307	仕事の所有者
308		308	タイトルで並べ替え
309		309	総ファイル サイズ
310		310	商標
311		311	ビデオ圧縮
312		312	ディレクター
313		313	データ速度
314		314	フレーム高
315		315	フレーム率
316		316	フレーム幅
317		317	球形
318		318	ステレオ
319		319	ビデオの向き
320		320	総ビット レート

以上。

ベームベーム

円と弧円の組み合わせで描く。

魔方陣や放射状の線、幾何学模様は中心を決めて描くとキレイ。

円を描く

中心と半径を決めてオートシェイプを作る。

Option Explicit

'線のデフォルトカラーと太さ。
Const LINE_BOLD As Long = 5
Const LINE_COLOR As Long = vbBlue

'オートシェイプ円の作成。
'円の中心と半径からオートシェイプの作成位置を計算。
Function makeShapeOval(ws As Worksheet, sX, sY, iRadius, _
                        Optional iLineColor As Long = LINE_COLOR, _
                        Optional iLineBold As Long = LINE_BOLD) As Shape
    
    Dim x As Double: x = sX - iRadius '円の開始位置
    Dim y As Double: y = sY - iRadius '円の開始位置
    Dim iDiameter As Double: iDiameter = iRadius * 2 '直径
    
    Dim myShape As Shape
    Set myShape = ws.Shapes.AddShape(msoShapeOval, x, y, iDiameter, iDiameter)
    
    With myShape
        .Line.Weight = iLineBold
        .Line.ForeColor.RGB = iLineColor '外枠
        .Fill.Visible = msoFalse '塗りつぶし無し
        '.Fill.ForeColor.RGB = iForeColor '塗りつぶし色
    End With
    
    Set makeShapeOval = myShape
    
End Function

'オートシェイプ直線の作成。ついでに作った。
Function makeShapeLine(ws As Worksheet, sX, sY, eX, eY, _
                        Optional iForeColor As Long = LINE_COLOR, _
                        Optional iLineBold As Long = LINE_BOLD) As Shape
    
    Dim myShape As Shape
    Set myShape = ws.Shapes.AddLine(sX, sY, eX, eY)
    
    With myShape.Line
        .Weight = iLineBold
        .ForeColor.RGB = iForeColor
    End With
    
    Set makeShapeLine = myShape
    
End Function

円状にオートシェイプを配置

円の大きさを決めて、円弧部分の座標を計算する練習。
幾何学模様を作るのに、そのまま使える。

'X座標計算用。
Function Coord_X(deg As Integer) As Double
    Dim pi As Double, dx As Double
    pi = WorksheetFunction.pi() '円周率
    dx = Cos(deg * pi / 180)
    Coord_X = dx
End Function

'Y座標計算用。
Function Coord_Y(deg As Integer) As Double
    Dim pi As Double, dy As Double
    pi = WorksheetFunction.pi() '円周率
    dy = Sin(deg * pi / 180)
    Coord_Y = dy
End Function

Sub テスト_放射状に線を描く()
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("テスト")
    
    '中心点を決める
    Dim iCenterLeft As Integer
    Dim iCenterTop As Integer
    iCenterLeft = Range("D12").Left
    iCenterTop = Range("D12").Top
    
    Dim 始点x As Double, 始点y As Double
    Dim 終点x As Double, 終点y As Double
    
    Dim i As Integer
    For i = 0 To 359 Step 3 '度
        始点x = Coord_X(i) * 0 + iCenterLeft
        始点y = Coord_Y(i) * 0 + iCenterTop
        終点x = Coord_X(i) * 100 + iCenterLeft
        終点y = Coord_Y(i) * 100 + iCenterTop
        Call makeShapeLine(ws, 始点x, 始点y, 終点x, 終点y)
    Next
    
End Sub

上記プログラムのベタ打ち値を変えればいろいろ作れる。楕円ぽい形も作れる。

扇形を作る

中心位置と半径、中心角と回転（角度の開始と終了）を決める。
扇形ぽく点を配置して、点と点を直線か曲線で結ぶ。
弧円部分は曲線で結び、弧円の終端と中心角は直線で結ぶ。
やることが多い。

'座標格納用。
Type dot
    x As Double
    y As Double
End Type

'フリーフォーマット形式で扇形のオートシェイプを作成する。
Function makeSector(ws As Worksheet, iCenterLeft, iCenterTop, iRadius, sAngle, eAngle, _
                Optional blnSector As Boolean = False, _
                Optional iForeColor As Long = LINE_COLOR, _
                Optional iLineBold As Long = LINE_BOLD) As Shape
    
    Dim myShape As Shape
    Dim ffb As FreeformBuilder
    
    Dim dx As Double, dy As Double
    Dim dotList() As dot
    Dim iDotCount As Integer
    
    Dim angle As Integer
    Dim apex As Integer
    
    apex = 15 '頂点の数のテスト値。
    
    Dim i As Integer
    For i = 0 To apex
        
        angle = i * (eAngle - sAngle) / apex
        dx = iCenterLeft + Coord_X(sAngle + angle - 90) * iRadius '-90で上を開始位置に調整
        dy = iCenterTop + Coord_Y(sAngle + angle - 90) * iRadius '同様
        
        iDotCount = iDotCount + 1
        ReDim Preserve dotList(1 To iDotCount)
        dotList(iDotCount).x = dx
        dotList(iDotCount).y = dy
        
    Next
    
    '取得した点を曲線で繋げる。
    For i = LBound(dotList) To UBound(dotList)
        
        dx = dotList(i).x
        dy = dotList(i).y
        
        Select Case i
        
        Case LBound(dotList)
            Set ffb = ws.Shapes.BuildFreeform(msoEditingAuto, dx, dy)
            
        Case LBound(dotList) + 1, UBound(dotList), UBound(dotList) - 1
            '最初と最後だけ直線で繋ぐと違和感少なめ。
            ffb.AddNodes msoSegmentLine, msoEditingAuto, dx, dy
            
        Case Else
            ffb.AddNodes msoSegmentCurve, msoEditingAuto, dx, dy
            
        End Select
        
    Next
    
    '扇形の直線部分は円弧の先端と円の中心を最後に繋ぐ。
    If blnSector Then
        ffb.AddNodes msoSegmentLine, msoEditingAuto, iCenterLeft, iCenterTop
        i = LBound(dotList)
        dx = dotList(i).x
        dy = dotList(i).y
        ffb.AddNodes msoSegmentLine, msoEditingAuto, dx, dy
    End If
    
    Set myShape = ffb.ConvertToShape '作成
    
    With myShape.Line '線
        .DashStyle = msoLineSolid '実線
        .Weight = iLineBold
        .ForeColor.RGB = iForeColor
    End With
    
    With myShape.Fill '塗りつぶし
        .Visible = msoFalse '無し
        '.ForeColor.RGB = iForeColor
    End With
    
    Set makeSector = myShape
    
End Function

その他、必要なヤツ

'ランダム名取得。オートシェイプに任意の名前を付けたい。
'エクセルがオートシェイプの名前を自動的に割り振ってくれるので実は要らない。
Function RandomName() As String
    With CreateObject("Scripting.FileSystemObject")
        RandomName = Replace(.GetTempName, ".tmp", "")
    End With
End Function

'描画部品の名前を保管。グループ化で使う。
'配列を1つ増やして追加する。
Sub ShapeNameArray(arr, s)
    On Error GoTo add1
    Dim i As Integer: i = 0
    i = UBound(arr)
add1:
    i = i + 1
    ReDim Preserve arr(1 To i)
    arr(i) = s
End Sub

各部品の配置場所を計算して設置

円弧の配置場所を計算する。
・正方形の対角線の比率は1:1:√2。
・外側の円の半径を1とした時、円弧の半径の比率は√2。
・円弧の中心位置は外側の円上の4か所、90度刻み。

中央の小さい円は、円弧の半径-外側の円の半径で求まる。

上記を計算しながらオートシェイプを配置。

Sub ベームベーム()
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("テスト")
    
    Dim centerCell As Range
    Dim coreDot As dot '中心点
    Dim outDot As dot '外周上の点を格納
    Dim myShape As Shape
    Dim arrName() As String
    
    Dim mainCircleSize  As Double: mainCircleSize = 100
    Dim tempCircleSize As Double: tempCircleSize = 0
    
    Set centerCell = Range("D10")
    coreDot.x = centerCell.Left
    coreDot.y = centerCell.Top
    Set myShape = makeShapeOval(ws, coreDot.x, coreDot.y, mainCircleSize, rgbBlue)
    myShape.Name = "外周1"
    Call ShapeNameArray(arrName, myShape.Name)
    
    '外周の円サイズを計算
    outDot.x = coreDot.x + Coord_X(0) * mainCircleSize
    tempCircleSize = (outDot.x - coreDot.x) * Sqr(2) '1:1:√2
    
    Dim i As Integer
    For i = 0 To 359 Step 90 '度
        outDot.x = coreDot.x + Coord_X(i) * mainCircleSize '外周の点を取得
        outDot.y = coreDot.y + Coord_Y(i) * mainCircleSize '外周の点を取得
        Set myShape = makeSector(ws, outDot.x, outDot.y, tempCircleSize, i - 45 - 90, i + 45 - 90, False)
        Call ShapeNameArray(arrName, myShape.Name)
    Next
    
    Set myShape = makeShapeOval(ws, coreDot.x, coreDot.y, tempCircleSize - mainCircleSize, rgbBlue)
    myShape.Name = "内周1"
    Call ShapeNameArray(arrName, myShape.Name)
    
    ws.Shapes.Range(arrName).Group.Name = "ベームベーム1"
    
End Sub

作った後は普通のオートシェイプと同様に線の色や太さ、点線変更できる。

以下はstep値だけ変えたもので、左から80度、60度、10度。

以上。

Choose関数

CHOOSE(インデックス、値1、値2、、、)

インデックスは整数で1から指定する。指定した～番目の値が返る。
Excel2003では29個、Excel2007以降では254個まで。

値部分にSUMとか式を入れ込んだりして複雑なものが作れる。

'エクセル数式
=CHOOSE(4, "A", "B", "C", "D") 'D

'VBA
Debug.Print Choose(1, "AA", "BB", "CC", "DD") 'AA

以上。

mp3バイナリ解析

mp3タグが文字化けしないよう、文字コードが調べたかった。
最初の3バイトが「ID3」で21バイト目が「01」ならOK！とやるだけでよかった。
それだけでよかったのに、、、

なんか長いのが出来た。
独学なので勘弁。

Option Explicit

Sub メイン処理()
    
    Dim mp3b As classBinaryID3V2
    Dim fileList() As String
    Dim iRow As Long
    Dim tmp As String
    
    Cells.ClearContents
    
    'このエクセルファイルが置かれたフォルダが対象
    Call makeFileList(ThisWorkbook.Path, True, fileList)
    
    Dim i As Long
    For i = LBound(fileList) To UBound(fileList)
        
        If Right(fileList(i), 4) <> ".mp3" Then GoTo fileSkip
        
        Set mp3b = New classBinaryID3V2
        With mp3b
            
            Cells(i, 1).Value = fileList(i)
            
            '先頭10バイトだけ読み込む。
            .SetHexList = readBinary(fileList(i), 10)
            
            'v2.3とv2.4以外を弾く。
            Dim strErrMsg As String: strErrMsg = .checkID3v2
            If Len(strErrMsg) > 0 Then
                Cells(i, 2).Value = strErrMsg: GoTo fileSkip
            End If
            
            'ヘッダーとフレームを全部読み込む。
            .SetHexList = readBinary(fileList(i), .GetAllFrameSize + 10)
            
            .NextFrame '最初のフレームをセット。
            
            Do While .GetFrameID <> ""
                
                '文字コードチェック
                'タイトル、アーティスト、アルバムを確認
                Select Case .GetFrameID
                Case "TIT2", "TPE1", "TALB"
                    tmp = .GetFrameCharacterCode
                    Cells(i, 2).Value = Choose(Int(tmp) + 1, "ISO-8859-1", "UTF-16", "UTF-16", "UTF-8")
                End Select
                
                'タグ情報出力。
                Select Case .GetFrameID
                Case "TIT2" 'タイトル
                    Cells(i, 3).Value = .GetFrameValue
                Case "TPE1" 'アーティスト
                    Cells(i, 4).Value = .GetFrameValue
                Case "TALB" 'アルバム
                    Cells(i, 5).Value = .GetFrameValue
                Case "TRCK" 'トラック
                    Cells(i, 6).Value = .GetFrameValue
                Case "TCON" 'ジャンル
                    Cells(i, 7).Value = .GetFrameValue
                Case "COMM" 'コメント
                    Cells(i, 8).Value = .GetFrameValue
                Case Else

                End Select
                
                .NextFrame '次のフレームを読み込む。
                
            Loop
            
        End With
fileSkip:
        Set mp3b = Nothing
        
    Next
    
    'カラム名後付け
    Rows(1).Insert
    Range("A1:H1").Value = Array("フルパス", "メモ", "タイトル", "アーティスト", "アルバム", "トラック", "ジャンル", "コメント")
    
End Sub

標準モジュールに追加

Option Explicit

'16進数を10進数に変換
Function HexToDec(sHex As String) As Long
    
    HexToDec = BinToDec(HexToBin(sHex))
    
End Function


'2進数を10進数に変換
Function BinToDec(sBin As String) As Long
    
    Dim tmp As String
    tmp = StrReverse(sBin) '文字を逆にする
    
    Dim iSum As Long: iSum = 0
    Dim i As Long
    For i = 1 To Len(tmp)
        If Mid(tmp, i, 1) = "1" Then
            iSum = iSum + 2 ^ (i - 1)
        End If
    Next
    
    BinToDec = iSum
    
End Function


'Syncsafe Integerを計算。16進数を10進数で返却。
'最上位8ビット目をスキップして連結
Function HexToSyncsafeInteger(sHex As String) As Long
    
    Dim rtnStr As String: rtnStr = ""
    
    Dim tmp As String
    tmp = HexToBin(sHex) '16進数を2進数に変換
    tmp = StrReverse(tmp) '文字を逆にする
    
    '最上位8ビット目をスキップして連結
    Dim i As Long
    For i = 1 To Len(tmp)
        If i Mod 8 <> 0 Then rtnStr = Mid(tmp, i, 1) & rtnStr
    Next
    
    HexToSyncsafeInteger = BinToDec(rtnStr)
    
End Function


'16進数を2進数に変換(マイナスとか色々考慮してません)
Function HexToBin(sHex As String) As String
    
    Dim rtnStr As String: rtnStr = ""
    
    Dim tmp As String
    Dim i As Long
    For i = Len(sHex) To 1 Step -1
        tmp = WorksheetFunction.Hex2Bin(Mid(sHex, i, 1))
        tmp = Right("000" & tmp, 4) '桁埋め
        rtnStr = tmp & rtnStr
    Next
    
    HexToBin = rtnStr
    
End Function

Sub 単体チェック用()
    
    Dim filePath As String
    filePath = "C:\音楽\〇〇〇.mp3"
    
    Call getMp3Info(filePath)
    
End Sub


'単体チェック用
Function getMp3Info(filePath As String) As Boolean
    
    Dim iFrameCnt As Long: iFrameCnt = 0
    
    Dim mp3b As classBinaryID3V2
    Set mp3b = New classBinaryID3V2
    
    With mp3b
        
        '先頭10バイトだけ読み込む。
        .SetHexList = readBinary(filePath, 10)
        
        'v2.3とv2.4以外を弾く。
        Dim strErrMsg As String: strErrMsg = .checkID3v2
        If Len(strErrMsg) > 0 Then Debug.Print strErrMsg: GoTo readEnd
        
        'ヘッダー部分を全部読み込む。
        .SetHexList = readBinary(filePath, .GetAllFrameSize + 10)
        
        Debug.Print .GetAllTagBinary
        Debug.Print "----------------------------------------"
        Debug.Print .GetHeaderBinary(" ")
        Debug.Print .GetHeaderID, .GetVersion, .GetAllFrameSize
        
        .NextFrame '次のフレーム（最初）
        
        Do While .GetFrameID <> ""
            
            Debug.Print "----------------------------------------"
            
            iFrameCnt = iFrameCnt + 1
            If iFrameCnt > 20 Then Exit Do '安全装置。タグが20個以上あるならコメントアウト。
            
            Debug.Print .GetFrameBinary(" ")
            Debug.Print .GetFrameID, .GetFrameNameJP, .GetFrameSize, .GetFrameValue
            
            .NextFrame '次のフレーム
            
        Loop
        
    End With
    
readEnd:
    Set mp3b = Nothing
    
End Function

'ファイルをバイナリ形式で読み出す。オプションでバイトサイズ指定。
Function readBinary(filePath As String, Optional readNumByte As Long = 0) As String()
    
    'ファイルサイズが0バイトは終了
    Dim iFileLen As Long
    iFileLen = FileLen(filePath)
    If iFileLen = 0 Then End
    
    Dim iFileNo As Integer
    iFileNo = FreeFile
    
    On Error GoTo OpenErr
    Open filePath For Binary As #iFileNo
    
    Dim bData() As Byte
    
    If readNumByte = 0 Then
        ReDim bData(1 To iFileLen) '全て読み込む
    Else
        ReDim bData(1 To readNumByte)
    End If
    
    Get #iFileNo, , bData
    Close #iFileNo
    
    '読み込んだデータの整形
    Dim sHex() As String
    ReDim sHex(LBound(bData) To UBound(bData))
    
    Dim i As Long
    For i = LBound(bData) To UBound(bData)
        sHex(i) = Right("0" & Hex(bData(i)), 2)
    Next
    
OpenErr:
    readBinary = sHex
    
End Function


'ファイルを検索してファイルリストを返却。
Sub makeFileList(sFolderPath As String, subFolderSearch As Boolean, ByRef fileList() As String)
    
    Dim fso As Object
    Dim folder As Object
    Dim subfolder As Object
    Dim file As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(sFolderPath)
    
    'サブフォルダが無ければループに入らず次へ
    If subFolderSearch Then
        For Each subfolder In folder.SubFolders
            Call makeFileList(subfolder.Path, subFolderSearch, fileList)
        Next subfolder
    End If
    
    For Each file In folder.files
        'Debug.Print file.Name, file.Path, file.Size
        Call addArrayString(fileList, file.Path)
    Next file
    
    Set subfolder = Nothing
    Set folder = Nothing
    Set fso = Nothing
    
End Sub

'配列を1つ増やして追加する。
Private Sub addArrayString(ByRef arr, s)
    On Error GoTo add1
    Dim i As Long: i = 0
    i = UBound(arr) '配列でない場合にエラー
add1:
    i = i + 1
    ReDim Preserve arr(1 To i)
    arr(i) = s
End Sub

classBinaryID3V2クラスを作成

Option Explicit

Private sHex() As String 'バイナリ
Private Location As Long 'フレームの開始位置
Public FrameCount As Long 'フレーム数

'主要タグ
Public TagTitle As String
Public TagArtist As String
Public TagAlbum As String
Public TagTrackNo As String
Public TagGenre As String
Public TagComment As String

'コンストラクタ
Private Sub Class_Initialize()
    Location = 1
    FrameCount = 0
    TagTitle = ""
    TagArtist = ""
    TagAlbum = ""
    TagTrackNo = ""
    TagGenre = ""
    TagComment = ""
End Sub


'バイナリを読み込む。
Public Property Let SetHexList(sHexList() As String)
    sHex = sHexList
End Property


'全てのフレームを巡回し、主要タグのテキストを取得する｡
Public Sub AllTagRead()
    
    Dim backupLocation As Long
    backupLocation = Location
    
    FrameCount = 0
    Location = 1
    NextFrame
    
    Do While GetFrameID <> ""
        
        FrameCount = FrameCount + 1
        
        Select Case GetFrameID
        Case "TIT2" 'タイトル
            TagTitle = GetFrameValue
        Case "TPE1" 'アーティスト
            TagArtist = GetFrameValue
        Case "TALB" 'アルバム
            TagAlbum = GetFrameValue
        Case "TRCK" 'トラック
            TagTrackNo = GetFrameValue
        Case "TCON" 'ジャンル
            TagGenre = GetFrameValue
        Case "COMM" 'コメント
            TagComment = GetFrameValue
        Case "APIC" 'アートワーク
            
        Case Else
            
        End Select
        
        NextFrame '次のフレームを読み込む。
        
    Loop
    
    Location = backupLocation
    
End Sub


'sHex配列の数を返す。
Private Function sHex_getCount() As Long
    
    Dim iCnt As Long: iCnt = 0
    
    On Error GoTo Err1
    iCnt = UBound(sHex)
Err1:
    sHex_getCount = iCnt
    
End Function


'sHex配列から指定した範囲で文字列を取得し、そのまま返す。
Private Function sHex_getString(iStart As Long, iLen As Long, Optional sDelimiter As String = "") As String
    
    Dim tmp As String: tmp = ""
    Dim i As Long
    Dim iEnd As Long: iEnd = (iStart + iLen - 1)
    
    If sHex_getCount < iEnd Then iEnd = sHex_getCount
    
    For i = iStart To iEnd
        If Len(sDelimiter) > 0 And Len(tmp) > 0 Then tmp = tmp & sDelimiter
        tmp = tmp & sHex(i)
    Next
    sHex_getString = tmp
    
End Function


'sHex配列から指定した範囲で文字列を取得し、アスキー変換する。
Private Function sHex_getStringAscii(iStart As Long, iLen As Long) As String
    
    Dim tmp As String: tmp = ""
    Dim i As Long
    For i = iStart To (iStart + iLen - 1)
        tmp = tmp & Chr(HexToDec(sHex(i)))
    Next
    sHex_getStringAscii = tmp
    
End Function


'sHex配列から指定した範囲で文字列を取得し、Shift-JISに変換する。
Private Function sHex_getStringShiftJIS(iStart As Long, iLen As Long) As String
    
    Dim sFrameVal As String: sFrameVal = ""
    Dim i As Long, tmp As String
    Dim iEnd As Long: iEnd = (iStart + iLen - 1)
    
    For i = iStart To iEnd
        
        'If sHex(i) = "00" And i = iEnd Then Exit For '終了フラグ
        If sHex(i) = "00" Then Exit For '終了フラグ
        
        If Is2byteShiftJIS(sHex(i), sHex(i + 1)) Then
            tmp = sHex(i) & sHex(i + 1)
            i = i + 1
        Else
            tmp = sHex(i)
        End If
        
        sFrameVal = sFrameVal & Chr(HexToDec(tmp))
    Next
    
    sHex_getStringShiftJIS = sFrameVal
    
End Function


'sHex配列から指定した範囲で文字列を取得し、Unicodeに変換する。
Private Function sHex_getStringUTF16(iStart As Long, iLen As Long, flgBigEndian As Boolean) As String
    
    Dim sFrameVal As String: sFrameVal = ""
    Dim i As Long, tmp As String
    
    For i = iStart To (iStart + iLen - 1) Step 2
        If flgBigEndian Then
            tmp = sHex(i) & sHex(i + 1)
        Else
            tmp = sHex(i + 1) & sHex(i)
        End If
        If tmp = "0000" Then Exit For '終了フラグ
        
        sFrameVal = sFrameVal & ChrW(HexToDec(tmp))
    Next
    
    sHex_getStringUTF16 = sFrameVal
    
End Function


'sHex配列から指定した範囲で文字列を取得し、UTF-8に変換する。UTF-8はBE、LEの概念が無い。
Private Function sHex_getStringUTF8(iStart As Long, iLen As Long) As String
    
    Dim sFrameVal As String: sFrameVal = ""
    Dim tmp As String, tmpBin As String
    Dim i As Long, k As Long, iByte As Long
    Dim iEnd As Long: iEnd = (iStart + iLen - 1)
    
    For i = iStart To iEnd
        
        If sHex(i) = "00" Then Exit For '終了フラグ
        
        iByte = NumByteUTF8(sHex(i))
        If iByte = 0 Then Exit For
        
        Select Case iByte
        Case 1
            tmpBin = Right(HexToBin(sHex(i)), 7)
            
        Case 2 To 6
            tmpBin = Right(HexToBin(sHex(i)), 7 - iByte)
            
            For k = 1 To iByte - 1
                tmp = Right(HexToBin(sHex(i + k)), 6)
                tmpBin = tmpBin + tmp
            Next
            
        Case Else
            '到達不可
            
        End Select
        
        tmp = ChrW(BinToDec(tmpBin))
        sFrameVal = sFrameVal & tmp
        i = i + iByte - 1
        
    Next
    
    sHex_getStringUTF8 = sFrameVal
    
End Function


'UTF-8のバイト数を判定。
Private Function NumByteUTF8(sHex1 As String) As Integer
    
    Dim rtnInt As Integer
    Dim sBin As String: sBin = HexToBin(sHex1)
    
    Select Case True
    Case Left(sBin, 2) = "10"
        rtnInt = 0
        Debug.Print "先頭バイトではありません(" & sHex1 & ")"
    Case Left(sBin, 1) = "0"
        rtnInt = 1
    Case Left(sBin, 3) = "110"
        rtnInt = 2
    Case Left(sBin, 4) = "1110"
        rtnInt = 3
    Case Left(sBin, 5) = "11110"
        rtnInt = 4
    Case Left(sBin, 6) = "111110"
        rtnInt = 5
    Case Left(sBin, 7) = "1111110"
        rtnInt = 6
    Case Else
        rtnInt = 0
        Debug.Print "判別不能(" & sHex1 & ")"
    End Select
    
    NumByteUTF8 = rtnInt
    
End Function


'Shift-JISのバイト数を判定。超無理矢理。1or2バイト。
'2バイト文字の1バイト目は0x81～9F、0xE0～EF。
'2バイト文字の2バイト目は0x40～7F、0x80～FC。
'これ以外を1バイト文字と判定。
Private Function Is2byteShiftJIS(sHex1 As String, sHex2 As String) As Boolean
    
    Is2byteShiftJIS = False
    If (HexToDec("81") <= HexToDec(sHex1) And HexToDec(sHex1) <= HexToDec("9F")) Or _
       (HexToDec("E0") <= HexToDec(sHex1) And HexToDec(sHex1) <= HexToDec("EF")) Then
       If (HexToDec("40") <= HexToDec(sHex2) And HexToDec(sHex2) <= HexToDec("7F")) Or _
          (HexToDec("80") <= HexToDec(sHex2) And HexToDec(sHex2) <= HexToDec("FC")) Then
            Is2byteShiftJIS = True
        End If
    End If
    
End Function


'ヘッダーIDを取得(マジックナンバーID3固定)
Property Get GetHeaderID() As String
    
    '1～3バイト固定
    If sHex_getCount < 3 Then
        GetHeaderID = ""
    Else
        GetHeaderID = sHex_getStringAscii(1, 3)
    End If
    
End Property


'ID3v2のバージョンを取得。
Property Get GetVersion() As String
    
    Dim tmp As String
    
    If sHex_getCount < 5 Then
        tmp = ""
    Else
        Select Case sHex(4) & sHex(5) '4～5バイト固定
        Case "0200"
            tmp = "2"
        Case "0300"
            tmp = "3"
        Case "0400"
            tmp = "4"
        Case Else
            tmp = ""
        End Select
    End If
    
    GetVersion = tmp
    
End Property


'ヘッダーのフラグを渡す。非同期化、拡張ヘッダ、実験中等を示す。
Property Get GetHeaderFlg() As String
    
    '6バイト目固定
    If sHex_getCount < 6 Then
        GetHeaderFlg = ""
    Else
        GetHeaderFlg = sHex_getString(6, 1)
    End If
    
End Property


'ID3v2.3、v2.4であることを確認する。問題無ければ空文字を返す。
Function checkID3v2() As String
    
    Dim rtnStr As String: rtnStr = ""
    Dim tmp As String
    
    Dim iCnt As Long: iCnt = sHex_getCount
    If iCnt < 10 Then
        rtnStr = "読み込めませんでした。(size " & iCnt & ")": GoTo checkEnd
    End If
    
    If GetHeaderID <> "ID3" Then
        rtnStr = "ID3v2のヘッダーではありません": GoTo checkEnd
    End If
    
    tmp = GetVersion
    If tmp <> "3" And tmp <> "4" Then
        rtnStr = "ID3v2.3かID3v2.4である必要があります。(ID3v2." & tmp & ")": GoTo checkEnd
    End If
    
    tmp = GetHeaderFlg
    If tmp <> "00" Then
        rtnStr = "フラグ(" & tmp & ")を持つファイルです。読み込みを中止しました。": GoTo checkEnd
    End If
    
checkEnd:
    checkID3v2 = rtnStr
End Function


'ヘッダーに書かれている全体フレームサイズを渡す。
Property Get GetAllFrameSize() As Long
    
    '7～10バイト固定
    Dim tmp As String
    If sHex_getCount < 10 Then
        GetAllFrameSize = ""
    Else
        tmp = sHex(7) & sHex(8) & sHex(9) & sHex(10)
        GetAllFrameSize = HexToSyncsafeInteger(tmp)
    End If
    
End Property


'次のフレームを読み込む。
Public Sub NextFrame()
    
    If Location = 1 Then
        Location = 11
    Else
        Dim iFS As Long: iFS = GetFrameSize
        If iFS > 0 Then Location = Location + iFS + 10
    End If
    
End Sub


'指定されたフレームIDを探す。見つからなければ空文字を返す。
'本処理を使用してフレームが見つからなかった場合、Location情報は失われる。
Property Get SearchFrame(sFrameID As String) As String
    
    Location = 11
    
    Dim tmp As String
    Dim tmpFrameID As String: tmpFrameID = ""
    Dim iFS As Long
    
    Do While Location < GetAllFrameSize
        
        tmp = sHex_getString(Location, 1)
        If tmp = "00" Then Exit Do
        
        tmpFrameID = sHex_getStringAscii(Location, 4)
        If tmpFrameID = sFrameID Then Exit Do
        
        iFS = GetFrameSize
        If iFS > 0 Then Location = Location + iFS + 10
        
    Loop
    
    If tmpFrameID = sFrameID Then
        SearchFrame = tmpFrameID
    Else
        Location = 1
        SearchFrame = ""
    End If
    
End Property


'現在のフレームIDを渡す。各フレームの頭1～4バイト固定。
Property Get GetFrameID() As String
    
    If Location < GetAllFrameSize Then
        
        Dim tmp As String
        tmp = sHex_getString(Location, 1)
        
        If tmp = "00" Then
            GetFrameID = "" '1バイト目が00なら空文字を返す
        Else
            GetFrameID = sHex_getStringAscii(Location, 4)
        End If
    Else
        GetFrameID = ""
    End If
    
End Property


'現在のフレームサイズを渡す。各フレームの5～8バイト固定。
Property Get GetFrameSize() As Long
    
    Dim tmp As String
    tmp = sHex_getString(Location + 4, 4)
    GetFrameSize = HexToDec(tmp)
    
End Property


'現在フレームのフラグを返す。各フレームの9～10バイト固定。
Property Get GetFrameHeaderFlg() As String
    
    GetFrameHeaderFlg = sHex_getString(Location + 8, 2)
    
End Property


'現在フレームの値について、文字コード部を返す。
Property Get GetFrameCharacterCode() As String
    
    '00:ISO-8859-1、中身はShift-JISを想定。
    '01:UTF-16BOM有
    '02:UTF-16BOM無(v2.4)
    '03:UTF-8(v2.4)
    
    Dim tmp As String
    tmp = sHex_getString(Location + 10, 1)
    GetFrameCharacterCode = tmp
    
End Property


'現在フレームの値を返す。
Property Get GetFrameValue() As String
    
    Dim tmp As String
    Dim rtnStr As String: rtnStr = ""
    
    Dim thisLocation As Long
    thisLocation = Location + 10
    
    Dim strCode As String
    Dim flgBigEndian As Boolean
    Dim iOffset As Long
    
    '最初の1バイトは文字コード判別用。
    strCode = sHex_getString(thisLocation, 1)
    
    Select Case strCode
    
    Case "00" '00:ISO-8859-1、中身はShift-JISを想定。
        
        rtnStr = sHex_getStringShiftJIS(thisLocation + 1, GetFrameSize - 1)
        
    Case "01", "02" '01:UTF-16BOM有、02:UTF-16BOM無(v2.4)
        
        iOffset = 1 '文字コード分
        flgBigEndian = False
        tmp = sHex(thisLocation + 1) & sHex(thisLocation + 2) 'BOMの判別
        
        If tmp = "FEFF" Or strCode = "02" Then: flgBigEndian = True
        If tmp = "FEFF" Or tmp = "FFFE" Then iOffset = iOffset + 2 'BOM分
        
        rtnStr = sHex_getStringUTF16(thisLocation + iOffset, GetFrameSize - iOffset, flgBigEndian)
        
    Case "03" '03:UTF-8(v2.4)
        
        iOffset = 1 '文字コード分
        tmp = sHex_getString(thisLocation + 1, 3) 'BOMの判別。3バイト。
        
        If tmp = "EFBBBF" Then iOffset = iOffset + 3 'BOM分
        
        rtnStr = sHex_getStringUTF8(thisLocation + iOffset, GetFrameSize - iOffset)
        
    Case Else
        
        Debug.Print "文字コード指定がありません。開始文字(" & strCode & ")"
        rtnStr = sHex_getStringShiftJIS(thisLocation, GetFrameSize)
        
    End Select
    
    GetFrameValue = rtnStr
    
End Property


'主要抜粋。
Property Get GetFrameNameJP() As String
    
    Dim rtnStr As String
    
    Select Case GetFrameID
    Case ""
        rtnStr = ""
    Case "TIT2"
        rtnStr = "タイトル"
    Case "TPE1"
        rtnStr = "アーティスト"
    Case "TALB"
        rtnStr = "アルバム"
    Case "TCON"
        rtnStr = "ジャンル"
    Case "TRCK"
        rtnStr = "トラックNo"
    Case "TYER"
        rtnStr = "リリース年" 'TYER(v2.3)、TDRC(v2.4)
    Case "COMM"
        rtnStr = "コメント"
    Case "APIC"
        rtnStr = "アートワーク"
    Case Else
        rtnStr = ""
        Debug.Print "■フレーム「" & GetFrameID & "」初出"
    End Select
    
    GetFrameNameJP = rtnStr
    
End Property


'以下、デバッグ用。

'ヘッダーのバイナリを返す(デバッグ用)
Property Get GetHeaderBinary(Optional sDmt As String) As String
    GetHeaderBinary = sHex_getString(1, 10, sDmt)
End Property

'フレームのバイナリを返す(デバッグ用)
Property Get GetFrameBinary(Optional sDmt As String)
    GetFrameBinary = sHex_getString(Location, GetFrameSize + 10, sDmt)
End Property

'ID3v2の全バイナリを返す。mp3本体以降は含まない。(デバッグ用)
Property Get GetAllTagBinary(Optional sDmt As String)
    GetAllTagBinary = sHex_getString(1, GetAllFrameSize + 10, sDmt)
End Property

書き換えはタグ編集ソフトでやる。

以上。