More than 1 year has passed since last update.

ExcelVBA 　汎用テクニック

ExcelVBA

Last updated at 2022-09-11Posted at 2022-09-03

自分用のメモなので、形は整ってないです。

Enumを使って、配列の何番目の要素が何のデータが入るのかを把握しやすくする。2次元配列を使う場合はこれでいきたい

Private Enum UserInfo  'Enumでインデックス番号を定義する
  氏名 = 1
  住所 = 2
  電話番号 = 3
  年齢 = 4
  所属部署 = 5
End Enum


Sub aaa()

Dim arr1(1 To 3, 1 To 5) As String ' 2次元配列を宣言。インデックスは1から始まるようにする

arr1(1, UserInfo.氏名) = "田中正敏"
' UserInfo. と入力した時点で候補が出るので、わかりやすい。インデックスの間違いも起こりにくい

arr1(1, UserInfo.住所) = "長崎県"
arr1(1, UserInfo.電話番号) = "0120-444-777"
arr1(1, UserInfo.年齢) = "45"
arr1(1, UserInfo.所属部署) = "開発課"

arr1(2, UserInfo.氏名) = "太田真紀子"
arr1(2, UserInfo.住所) = "石川県"
arr1(2, UserInfo.電話番号) = "0256-444-777"
arr1(2, UserInfo.年齢) = "25"
arr1(2, UserInfo.所属部署) = "人事課"

arr1(3, UserInfo.氏名) = "武藤正治"
arr1(3, UserInfo.住所) = "沖縄県"
arr1(3, UserInfo.電話番号) = "0444-444-777"
arr1(3, UserInfo.年齢) = "61"
arr1(3, UserInfo.所属部署) = "庶務課"

Dim i As Long
Dim j As Long

For i = 1 To 3
  Debug.Print "社員番号:" & i
  For j = 1 To 5
    Debug.Print arr1(i, j)
  Next j
  Debug.Print "------------------------"
Next i

End Sub

要素の追加・削除などが多い場合には、配列ではなくCollectionを使う

Sub aaa()

Dim arr1(1 To 5) As String

arr1(1) = "AAA"
arr1(2) = "BBB"
arr1(3) = "CCC"
arr1(4) = "DDD"
arr1(5) = "EEE"
' このような配列で、arr1(3)だけを削除したいとなると、他の配列に移し替えるなど手間が大変になる

Dim col1 As New Collection

col1.Add "AAA"
col1.Add "BBB"
col1.Add "CCC"
col1.Add "DDD"
col1.Add "EEE"
'Collectionを使って、要素の削除、追加が容易な形にすることができる

Call getData(col1)
Debug.Print "---------------------"

col1.Remove (3) '3番目の要素を削除。4番目以降の要素は自動で前詰めされる

Call getData(col1)
Debug.Print "---------------------"

col1.Add Item:="FFF", Before:=2  ' 2番目の要素の前に追加する

Call getData(col1)

'要素の追加･削除が多い場合は、配列ではなくCollectionを使うといい



End Sub

Sub getData(ByRef xCol As Collection)

Dim i As Long

For i = 1 To xCol.Count
  Debug.Print xCol(i)
Next i

End Sub

Select Case を使って、判定式に複数の条件を設定する

Sub aaaa()

Call CaseTrue1(85)  '優秀です
Call CaseTrue1(58)  '普通です
Call CaseTrue1(39)  '不合格です

Call CaseTrue2(105, 55, 50)  'パターン1
Call CaseTrue2(50, 55, 60)   'パターン2
Call CaseTrue2(60, 60, 70)   'パターン3
Call CaseTrue2(60, 60, 40)   'どのパターンでもない
Call CaseTrue2(40, 41, 100)  'どのパターンでもない

Call CaseTrue3

End Sub


Sub CaseTrue1(ByVal xValue As Long)

Select Case True  ' Case True とすることで、変数の評価ではなく条件の評価になる
  Case xValue > 80
    Debug.Print "優秀です"
  Case xValue <= 80 And xValue >= 40   ' 複数の条件式の組み合わせも可能
    Debug.Print "普通です"
  Case Else
    Debug.Print "不合格です"
End Select

End Sub


Sub CaseTrue2(ByVal value1 As Long, ByVal value2 As Long, ByVal value3 As Long)

Select Case True
  Case value1 > 100, value2 < 0  'これは　value1 > 100 Or value2 < 0 の評価式になる
    Debug.Print "パターン1"
  Case value1 = 50, value2 = 50, value3 = 50  'これもOr条件
    Debug.Print "パターン2"
  Case value1 = value2 And value1 < value3  'これは普通にAND条件
    Debug.Print "パターン3"
  Case Else
    Debug.Print "どのパターンでもない"
End Select

End Sub



Sub CaseTrue3()

On Error Resume Next

If 100 > 0 Or (10 / 0) > 0 Then
' IF文は、「100 > 0」と「(10 / 0) > 0」の両方を評価してしまうので、0除算でエラーが発生する
  Debug.Print "TRUE"
End If

If Err.Number <> 0 Then
  Debug.Print "IFでエラー発生"
End If
Err.Clear


Select Case True
  Case 100 > 0, (10 / 0) > 0
  'CASEの場合は、100 > 0が成立したと判定した時点で評価を止める(ショートサーキット)。そのためエラーにならない
    Debug.Print "成立"
  Case Else
    Debug.Print "不成立"
End Select

'  Case (10 / 0) > 0, 100 > 0　この構文はエラーになるので注意

If Err.Number <> 0 Then
  Debug.Print "CASEでエラー発生"
End If

End Sub

多重構造野のループになっている場合に、内側のループから外側のループを抜ける例　　GoTo文も使って悪いことは無い

Sub aaa()

Dim i As Long
Dim j As Long

'種類の違うループを組み合わせて、内側のループから外側のループを抜ける
Do
  For i = 0 To 100
    If i > 10 Then Exit Do  'これで外側のループを抜けられる
    Debug.Print i
  Next i
Loop

 
' GoTo文で、ループの1回分の処理をスキップしたり、ループを抜けるのは悪いコードではない、かな
For i = 1 To 10
  For j = 1 To 10
    If j Mod 2 = 0 Then GoTo Continue   'jのループを1回分スキップ。Java等のcontinueの代わり
    If i > 5 And j > 5 Then GoTo ExitOuterLoop
    Debug.Print "i= " & i
    Debug.Print "j= " & j
Continue:
  Next j
Next i

ExitOuterLoop:

End Sub

シート名やシート番号が変化しても、シートの指定に問題が起きないシートの指定方法

Worksheets("シート2").Activate
Worksheets(2).Activate
'このようにシート名やシート番号での指定は、ユーザ側の変更で正常動作しなくなる可能性がある

Sheet2.Activate
'シート名、シート番号での指定ではなく、シートのオブジェクト名(Sheet2)を指定してActivateにする

'※シート名が変更されても、他のシートの削除・追加があっても、
'「Sheet2」というオブジェクト名には変化が無いらしい。VBA側からしか変更できない

'シートのオブジェクト名は、プロパティウィンドウから変更できる

OffsetとResizeを使って、選択しているセル範囲を変更する　　かなり使える内容

Sub aaa()

'*********  Offset  ***********
Range(Cells(1, 1), Cells(5, 5)).Select

Selection.Offset(2, 3).Select
'選択している範囲から、行方向へ2(下方向)、列方向へ3(右方向)だけ範囲を移動する

Selection.Offset(-1, -2).Select
'選択している範囲から、行方向へ-1(上)、列方向へ-2(左)だけ範囲を移動する

'Cells(1, 1).Select
'Selection.Offset(-1, -2).Select  これはマイナスのアドレスになるのでエラーが発生する。注意

Range(Cells(1, 1), Cells(3, 3)).Offset(3, 2).Select
'セル範囲に対してOffsetを指定することも可能

Range(Cells(1, 1), Cells(3, 3)).Offset(2).Select
'移動が0の場合は省略できる。これは行方向へ2

Range(Cells(1, 1), Cells(3, 3)).Offset(, 2).Select
'これは列方向へ2

End Sub


Sub bbb()

'*********  Riseze  ***********
Range(Cells(1, 1), Cells(5, 5)).Select

Selection.Resize(2, 3).Select
'選択している範囲の左上端のセルを基準にして、2行分、3列分の範囲を選択する

Range(Cells(1, 1), Cells(5, 5)).Select
Selection.Resize(2).Select
'列数を省略すると、列に関しては元の範囲と同じになる

Range(Cells(1, 1), Cells(5, 5)).Select
Selection.Resize(, 2).Select
'これは行の範囲が元の範囲と同じになる

'Resizeでマイナス数値を指定することは無い

End Sub


Sub ccc()

Cells(1, 1).CurrentRegion.Select
Selection.Resize(Selection.Rows.Count - 1).Offset(1).Select
'Cells(1, 1)のデータ範囲で、1行目を除いた部分を選択する例
'表の1行目はタイトルである事が多いので、データ部分だけを選択するのに使える

Dim range1 As Range
Set range1 = Cells(1, 1).CurrentRegion

range1.Resize(range1.Rows.Count - 1).Offset(2, 2).Select
range1.Resize(range1.Rows.Count - 2).Offset(3).Select
'Rangeオブジェクトに対して実行も可能

Set range1 = Range(Cells(1, 1), Cells(5, 5))
range1.Resize(1).Select  '一番上の1行だけ選択
range1.Resize(, 1).Select '一番左の1列だけ選択

range1.Offset(range1.Rows.Count - 1).Resize(1).Select
'これはややこしいが、range1の最終行だけ選択

range1.Offset(, range1.Columns.Count - 1).Resize(, 1).Select
'range1の最終列だけ選択



'※結合セルに対してはOffsetやResizeは正常に働かないという情報があるが、修正された？

'A11～A13と、B10～D10は結合してある
Range("A10").Select
Debug.Print Selection.Offset(1).Address  '$A$11
Debug.Print Selection.Offset(2).Address  '$A$12
Debug.Print Selection.Offset(3).Address  '$A$13
Debug.Print Selection.Offset(4).Address  '$A$14

Debug.Print "------------------------"

Debug.Print Selection.Offset(, 1).Address  '$B$10
Debug.Print Selection.Offset(, 2).Address  '$C$10
Debug.Print Selection.Offset(, 3).Address  '$D$10
Debug.Print Selection.Offset(, 4).Address  '$E$10

Selection.Resize(5).Select  '正常に5セルが選択されている

End Sub

セル範囲の値をVariant型へ格納し、配列として扱う

高速処理だが、結合セルがあった場合や、1セルのみの範囲だった場合は注意が必要

'セル範囲の値をVariantへ格納
Sub aaa()

Dim var1 As Variant
Dim var2 As Variant
Dim i As Long
Dim j As Long

ActiveSheet.Cells.Clear  '全てクリア

ActiveSheet.Range(Cells(1, 1), Cells(10, 5)).Value = 123
var1 = ActiveSheet.Range(Cells(1, 1), Cells(10, 5)).Value
' セル範囲をバリアント変数に格納すると、二次元配列の形になる
'アクティブなシートでないとエラーになるので注意

Debug.Print UBound(var1, 1)  '10  1次元目の要素数
Debug.Print UBound(var1, 2)  '5   2次元目の要素数

Debug.Print "------------------------------"

For i = 1 To 10
' var1は二次元配列の形になっているが、インデックスは0ではなく1から始まるので注意
  For j = 1 To 5
    Cells((i + 10), j).Value = var1(i, j)
    ' セルにvar1のデータを格納していく
  Next j
Next i

'配列の1次元目と2次元目の要素数を利用してループしてもいい
For i = LBound(var1, 1) To UBound(var1, 1)
  For j = LBound(var1, 2) To UBound(var1, 2)
    Debug.Print var1(i, j)
  Next j
Next i

Debug.Print "------------------------------"

Range(Cells(21, 1), Cells(30, 5)).Value = var1
' 一括でセル範囲にデータを格納する方法

  
'1セルのみの範囲だった場合は、バリアント型変数の内容は配列にならない
'*次元目の要素数を取得しようとするとエラーになる
var2 = ActiveSheet.Range(Cells(1, 1), Cells(1, 1)).Value
On Error Resume Next
Debug.Print UBound(var2, 1)  'このコードはエラー
If Err.Number <> 0 Then MsgBox "エラー"
On Error GoTo 0
'※配列の要素数の取得時には、必ずエラートラップをするべき


'以下のようにVarTypeで判定するのもありかも
var1 = ActiveSheet.Range(Cells(1, 1), Cells(10, 5)).Value
var2 = ActiveSheet.Range(Cells(1, 1), Cells(1, 1)).Value
Debug.Print VarType(var1)  '8204  バリアント配列は、「8192+12」になるらしい。セルの値は関係しないみたい
Debug.Print VarType(var2)  '5     これはセルの値による

End Sub




'セルに数式を入れてVariantへ格納
Sub bbb()

Dim var1 As Variant
Cells.Clear  '全てクリア

Cells(1, 1).Value = 100
Cells(1, 2).Formula = "=RC[-1]*200"  '数式のセルにする

var1 = Range(Cells(1, 1), Cells(1, 2)).Value
Debug.Print var1(1, 1)   '100
Debug.Print var1(1, 2)   '20000   数式のセルでも、値の取得はできる
Debug.Print VarType(var1(1, 1))  '5   Double型
Debug.Print VarType(var1(1, 2))  '5   Double型

Cells(1, 3) = var1(1, 2) / 20
Debug.Print Cells(1, 3).Value  '1000  普通に計算できるみたい

End Sub


'選択している範囲をVariantへ格納
Sub ccc()

Dim var1 As Variant
Dim i As Long
Dim j As Long

Cells.Clear  '全てクリア

For i = 1 To 10
  For j = 1 To 10
    Cells(i, j).Value = i + j
  Next j
Next i

Range(Cells(2, 2), Cells(5, 5)).Select
var1 = Selection  'これで選択範囲を格納できるらしい

Stop  'ここで、手動で離れた複数のセル範囲を選択してみる

var1 = Selection   'これは最初に選択した範囲のみが格納されているようだ
Stop

Dim range1 As Range
Dim range2 As Range
Dim unionRange As Range

Set range1 = Range(Cells(1, 1), Cells(3, 3))
var1 = range1.Value  'range1の範囲が格納されている
Stop

Set range2 = Range(Cells(5, 5), Cells(7, 7))
Set unionRange = Union(range1, range2)  '2つのRangeを結合する
unionRange.Interior.ColorIndex = 5  '背景色を青に

var1 = unionRange  'これはrange1の部分しか格納されていないようだ
Stop

End Sub


'結合セルがある範囲をVariantへ格納
Sub ddd()

Dim var1 As Variant
Dim i As Long
Dim j As Long

Application.DisplayAlerts = False
Cells.Clear  '全てクリア

For i = 1 To 10
  For j = 1 To 10
    Cells(i, j).Value = i + j
  Next j
Next i

var1 = Range(Cells(1, 1), Cells(1, 2))
Debug.Print VarType(var1(1, 1))   '5   Double型
Debug.Print VarType(var1(1, 2))   '5   Double型

Range(Cells(1, 1), Cells(1, 2)).Merge   '2つのセルを結合
var1 = Range(Cells(1, 1), Cells(1, 2))
Debug.Print VarType(var1(1, 1))   '5   Double型
Debug.Print VarType(var1(1, 2))   '0   Empty値になる
'結合したセル範囲をVariantに格納すると、左上のセル以外はEmptyになるので注意

Debug.Print var1(1, 2) = ""  'True  Emptyなので空文字と一致すると判定される
Debug.Print var1(1, 2) = 0   'True  Emptyなので0と一致すると判定される

Debug.Print "-----------------------"

var1 = Range(Cells(3, 3), Cells(6, 6))
Debug.Print UBound(var1, 1)  '4   1次元目の要素数

Range(Cells(3, 3), Cells(6, 6)).Merge
var1 = Range(Cells(3, 3), Cells(6, 6))
Debug.Print UBound(var1, 1)  '4    結合していても、配列の要素数が変わるわけではない

End Sub



'セル範囲をVariantに格納する方法と、1セルずつ取得する方法の速度差の測定
Sub eee()

Dim startTime As Double
Dim endTime As Double
Dim total As Long
Dim i As Long
Dim j As Long

Application.ScreenUpdating = False

Cells.Clear  '全てクリア

For i = 1 To 1000
  For j = 1 To 1000
    Cells(i, j).Value = i + j
  Next j
Next i

Dim range1 As Range
Dim var1 As Variant

startTime = Timer
total = 0

'Variant変数に代入し、配列を走査して処理
Set range1 = Range(Cells(1, 1), Cells(1000, 1000))
var1 = range1.Value 'var1にrange1の範囲のセルの値を全て格納

For i = LBound(var1) To UBound(var1)
  For j = 1 To 1000
    If var1(i, j) Mod 3 = 0 Then
      total = total + var1(i, j)
    End If
  Next j
Next i

endTime = Timer

Debug.Print total  '  333666000
Debug.Print endTime - startTime  ' 0.296875


startTime = Timer
total = 0

'セルを1つずつ参照して処理
For i = 1 To 1000
  For j = 1 To 1000
    If Cells(i, j).Value Mod 3 = 0 Then
      total = total + Cells(i, j).Value
    End If
  Next j
Next i

endTime = Timer

Debug.Print total  '  333666000
Debug.Print endTime - startTime  ' 3.921875

'Variant変数に代入するほうが、セルを参照する方法よりも10倍以上速い。範囲が広がるほど差がつくらしい

End Sub

(3,10)、3行×10列の配列を、行と列を入れ替えてシートに貼り付け、10行×3列の形にする。結構便利

Sub hhh()

Dim arr1() As Long
Dim i As Long
Dim long1 As Long

Range(Cells(1, 1), Cells(10, 3)).Clear

long1 = 0
For i = 1 To 10
  long1 = long1 + 1
  ReDim Preserve arr1(1 To 3, 1 To long1)  '動的配列の最後の次元の要素数だけを変更していく
  arr1(1, long1) = long1
  arr1(2, long1) = long1 + 1
  arr1(3, long1) = long1 + 2
Next i

'この時点で、arr1は(3,10)の配列になっている。このままシートに貼り付けると3行×10列になる

Cells(1, 1).Resize(long1, 3).Value = Application.WorksheetFunction.Transpose(arr1)
'Transposeで、行と列を入れ替えてシートに貼り付け。10行×3列の形になる


Range(Cells(15, 1), Cells(17, 10)).Clear

Dim var1 As Variant
var1 = Range(Cells(1, 1), Cells(10, 3)).Value  '上で貼り付けたセル範囲をvar1に格納する
var1 = Application.WorksheetFunction.Transpose(var1)
'これでvar1の行と列が入れ替わる

For i = 1 To 10
  Cells(15, i).Value = var1(1, i)
  Cells(16, i).Value = var1(2, i)
  Cells(17, i).Value = var1(3, i)
Next i
'再度3行×10列の形で出力

End Sub

離れている複数のセル範囲を取得する　Areas

Sub aaa()

Dim range1 As Range
Dim range2 As Range
Dim rowsCnt As Long
Dim i As Long

Range("A1:C20").Clear

Set range1 = Range("A1:C3, A7:C11")  '離れている2つのセル範囲をSet
range1.Interior.ColorIndex = 4

Debug.Print range1.Rows.Count  '3になる。8行分選択されているはずだが


rowsCnt = 0
For i = 1 To range1.Areas.Count
'Areas.Countでセル範囲の数を取得。今回の場合は2

  Set range2 = range1.Areas(i)  'range2に、range1のi番目の範囲をセット
  rowsCnt = rowsCnt + range2.Rows.Count
Next i

Debug.Print rowsCnt  '8　正確に行数を取得できる

Debug.Print "----------------------"

'**********   Unionで複数の範囲を結合する  *******

Range("A1:C20").Clear
Set range1 = Range(Cells(1, 1), Cells(3, 3))
Set range1 = Union(range1, Range(Cells(7, 1), Cells(12, 3)))
'Unionで2つの範囲を結合する
'Set range1 = (range2,range3)  というコードは不可らしいので、Unionで

Set range1 = Union(range1, Range(Cells(16, 1), Cells(20, 3)))
range1.Interior.ColorIndex = 5

rowsCnt = 0
For i = 1 To range1.Areas.Count
  Set range2 = range1.Areas(i)
  rowsCnt = rowsCnt + range2.Rows.Count
Next i
Debug.Print rowsCnt  '14

Debug.Print "----------------------"


Range("A1:C20").Clear
Set range1 = Range(Cells(1, 1), Cells(3, 3))
Set range1 = Union(range1, Range(Cells(2, 1), Cells(7, 3)))
'重複する部分がある2つの範囲を結合する
range1.Interior.ColorIndex = 3

rowsCnt = 0
For i = 1 To range1.Areas.Count
  Set range2 = range1.Areas(i)
  rowsCnt = rowsCnt + range2.Rows.Count
Next i
Debug.Print rowsCnt  '7になる。重複する部分は2重にカウントされていない

'重複する部分がある2つの範囲を結合した場合は、重複部分は吸収されるらしい

End Sub

WorksheetFunctionでは使えない関数(CODE関数等)を、Evaluateを利用して使う

Cells(1, 1).Value = "藍"
Cells(1, 2).Formula = "=CODE(RC[-1])"
'CODE関数は、指定した文字に対応する文字コードを取得する
Debug.Print Cells(1, 2).Value  '19829

'Debug.Print Application.WorksheetFunction.CODE("藍")
'このコードはエラー。WorksheetFunctionではCODE関数を使えない


Debug.Print Application.Evaluate("CODE(""藍"")")  '19829
'Evaluateで文字列を数式やオブジェクトに解釈する。文字列しか指定できないので注意
  
'Evaluateは、数式の文字列やセル範囲の文字列を解釈することができるので、結構便利かも

複数のセル範囲(”A1:B2” と "D4:E5" 等)を選択する、複数のセル範囲の共通する部分を取得する方法

Range("A1:F10").Clear

Range("A1:E5").Interior.ColorIndex = 5
Range("C3:F7").Interior.ColorIndex = 4
'2つのセル範囲の背景色を変更

Range("A1:E5 C3:F7").Interior.ColorIndex = 3
'2つのセル範囲の共通部分を赤に  半角スペースが共通部分を示す演算子になるらしい


Range("A1:F10").Clear
Range("A1:E5,C3:F7").Interior.ColorIndex = 5
'カンマは複数の範囲を並べる演算子になる

Evaluateで、セル範囲や数式の文字列を解釈する

Sub bbb()

Dim str1 As String
Dim range1 As Range

Range("A1:A10").Clear

str1 = "A1:A10"  'セル範囲の文字列を設定

Set range1 = Evaluate(str1)
'Evaluateで、セル範囲の文字列を解釈する
range1.Interior.ColorIndex = 5
'A1:A10の範囲の背景色が変化する


Range("A1:A10").Clear
Range("A1").Value = 1000
str1 = "=A1*100"  '数式の文字列を設定

Debug.Print Evaluate(str1)  '100000
'数式の文字列を解釈する

Debug.Print Evaluate("=A1*100")  '100000
'文字列を直接入れても同じ

Debug.Print [=A1*100]  '100000
'[]を使う方法もある。このほうが簡潔か

Debug.Print [str1]    '=A1*100
'ただし、このように変数を[]で解釈することはできない。エラーにはならないようだが

'※Evaluateは注意するべき点も多いようだが、利用価値は高そう

End Sub

関数を組み合わせた複雑な処理を、途中経過を格納する変数を使って理解しやすくする

Sub aaa()

Dim arr1(1 To 3) As String
Const EM_SPACE = "　"  '全角スペースの定数
Dim i As Long

arr1(1) = "大橋　雄太"
arr1(2) = "川上 恵子"
arr1(3) = "杉本　正一"
'姓と名の間が、半角スペースと全角スペースの混在になっている

For i = 1 To 3
  Debug.Print Mid$(arr1(i), InStr(StrConv(arr1(i), vbWide), EM_SPACE) + 1)
  'arr1(i)の文字列を全角へ変換し、全角スペースの位置を求めて、名の部分だけ出力する
  'この処理内容はかなり把握しにくい
Next i


Debug.Print "--------------------------"

Dim pos As Long  '全角スペースの位置を示す
Dim tmp As String

For i = 1 To 3
  tmp = StrConv(arr1(i), vbWide)
  pos = InStr(tmp, EM_SPACE)
  Debug.Print Mid$(tmp, pos + 1)
  'このように、変数を使って中間処理をしていくと理解しやすい
  'コードは長くなるが、メンテナンス性を考えるとこちらがいいか
Next i

End Sub

よく使う関数(MsgBox等)を、Functionでカスタマイズする

Sub aaa()

MsgBox "情報アイコンのBOX"
'これは、デフォルトのMsgBox関数ではなくMsgBox Functionが呼ばれる

VBA.MsgBox "本来のBOX"
'デフォルトのMsgBox関数を使う場合はこれで

'よく使う関数は、カスタムしたFunctionを用意しておくべきか

End Sub

Function MsgBox(ByVal prompt As String) As VbMsgBoxResult
'情報アイコンがあるメッセージボックスを表示するFunction　名前はあえて "MsgBox" にしている

  MsgBox = VBA.MsgBox(prompt, vbInformation)
  'VBA.MsgBox としないと、自分自身と区別がつかなくなるので注意

End Function

デフォルト値を持つ引数を指定するなど、Function関連の話　Optional、ParamArray

Sub aaa()

'*********  デフォルト値を持つ引数があるFunction　　*****

  Debug.Print func1(1000, 0.15)  '第2引数も指定   850
  Debug.Print func1(1000)        '第2引数は省略   800

  Debug.Print func2(1000, 0.3)   '第2引数も指定   700
  Debug.Print func2(1000)        '第2引数は省略   800
  
  Debug.Print "-----------------"
  
'*********  引数の数が不定のFunction　　*****************

  Debug.Print func3(10, 20, 30)  '60
  Debug.Print func3(-100)        '-100
  Debug.Print func3()            '0
  
  Debug.Print "-----------------"
  
'********* 擬似的に、複数の値を返すFunction　　*****************

  Dim long1 As Long
  Dim long2 As Long
  Dim long3 As Long
  
  long1 = 100
  long2 = 200
  long3 = 300
  
  If func4(long1, long2, long3) Then
    Debug.Print long1  ' 1000   参照渡しで値が変更されたので
    Debug.Print long2  ' 40000
    Debug.Print long3  ' 900000
  End If
  
  '3つの変数の値が変更されたので、実質3つの戻り値を受け取ったようなもの、かな

End Sub


Function func1(ByVal price As Double, Optional ByVal discount As Double = 0.2) As Double
'Optionalをつけた引数は、デフォルト値を使用できる。discountのデフォルト値は0.2
'Optionalをつけた引数以降は、全てOptional付きでなくてはならない

  func1 = price * (1 - discount)

End Function


Function func2(ByVal price As Double, Optional ByVal discount As Variant) As Double
'デフォルト値を指定しない例

  If IsMissing(discount) Then
  'IsMissingで、引数の指定が省略されたかを判定できる
  '判定できるのはVariant型の引数のみ。他の型は常にTrueになってしまう
    discount = 0.2
  End If
  
  func2 = price * (1 - discount)

End Function


Function func3(ParamArray values()) As Long
' "ParamArray" キーワードで、可変長の引数である事を宣言。ByRefとかと同じ役割
'可変長の引数は、引数の最後に1つだけしか指定できない。Variant型のみ。Longとかにするとエラーなので型は省略で
'可変長の引数は配列扱いなので、参照渡しになる。ByRefとかは付けられない

  Dim total As Long
  Dim i As Long
  
  total = 0
  For i = LBound(values) To UBound(values)
    total = total + values(i)
  Next i
  
  func3 = total
End Function


Function func4(ByRef long1 As Long, ByRef long2 As Long, ByRef long3 As Long) As Boolean
'全ての引数を参照渡しで受け取る

  On Error GoTo func4EH

  long1 = long1 * 10
  long2 = long2 * 200
  long3 = long3 * 3000
  func4 = True
  
  Exit Function
  
func4EH:
  func4 = False

End Function

TypeName関数で、オブジェクトの種類を調べる

Dim long1 As Long
Dim range1 As Range

long1 = 100
Set range1 = Range(Cells(1, 1), Cells(10, 5))

Debug.Print TypeName(long1)   ' Long
Debug.Print TypeName(range1)  'Range

Dim objFSO As FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

Debug.Print TypeName(objFSO)  'FileSystemObject


ActiveSheet.Shapes.AddShape(msoShapeRectangle, 700, 500, 200, 100).Select
'四角形の図形を追加
Debug.Print TypeName(Selection)   'Rectangle

ActiveSheet.Shapes.SelectAll  '全図形を選択
Debug.Print TypeName(Selection)   'DrawingObjects
'DrawingObjectsは、オブジェクトブラウザで「非表示のメンバを表示」にチェックを入れないと検索できない

'TypeNameを使えば、オブジェクトの種類が把握しやすくなるので、積極的に使おう
'RectangleやDrawingObjectsなどの値は返さないとなっているけど、間違い?

条件付コンパイル　　#Const ～で宣言した定数を、#IF ～ #End If 内だけで使用できるもの

Excelのバージョンの違いによるコードの切り替えや、開発時/運用時のコード切り替えに使うと便利

Option Explicit

'条件付コンパイル構文は、宣言部に記述できる

#Const ENVIROMENT = 0 '開発時は0、運用時は1にする

' #Const で宣言した定数は、#IF ～ #End If内でしか使えない
#If ENVIROMENT = 0 Then
  Private Const VAL1 = 100   '#IF ～ #End If内で定数を宣言。これはどこでも使える
  Private Const VAL2 = 200
  Private Const VAL3 = 300
#Else
  Private Const VAL1 = -100
  Private Const VAL2 = -200
  Private Const VAL3 = -300
#End If


Sub aaa()

  Debug.Print VAL1  '100    ENVIROMENT = 1 にすれば-100
  Debug.Print VAL2
  Debug.Print VAL3
  
  ' Debug.Print ENVIROMENT  このコードはエラー
  
End Sub



Sub bbb()
' #IF ～ #End Ifは、プロシージャ内でも記述可能
' システムで用意されたコンパイラ定数(#IF ～ #End If内でしか使えない)もある


'********  何ビットシステムかを判定   *******

#If Win64 Then
'64ビット互換である
  Debug.Print "64ビット"
  
#ElseIf Win32 Then
'32ビット互換である
  Debug.Print "32ビット"

#ElseIf Win16 Then
'16ビット互換である
  Debug.Print "16ビット"
#End If

'※64ビット互換の場合は、Win32もTrueになるので、判定の順番に注意


'********  VBAのバージョンを判定   *******

#If VBA7 Then
'Visual Basic for Applications バージョン 7.0 互換 Office2010以降はこれ
  Debug.Print "VBA7"
  
#ElseIf VBA6 Then
'Visual Basic for Applications バージョン 6.0 互換　Office2007以前
  Debug.Print "VBA6"
#End If

'※VBA7の場合は、VBA6もTrueになるので、判定の順番に注意


'********  MACであるかを判定   *******

#If Mac Then
'Macintosh である
  Debug.Print "MACのPC"
#Else
  Debug.Print "MACのPCではない"
#End If

End Sub

FileSystemObjectオブジェクト等は、事前バインディングと実行時バインディングで少し性質が異なる。開発時は事前バインディングが有利なので、条件付コンパイルを使って切り替えをする方法

#Const ENVIROMENT = 1 '条件付コンパイル定数　開発時は0、運用時は1にする


Sub aaa()

'******　事前バインディング　　*********
Dim FSO1 As FileSystemObject
' 参照設定で、Microdoft Scripting Runtimeの参照が必要
' コードの自動補完ができる
' 実行スピードが若干速い

Set FSO1 = New FileSystemObject
Debug.Print FSO1.GetFolder("C:\work").Files.Count


'******　実行時バインディング　　*********
Dim FSO2 As Object
Set FSO2 = CreateObject("Scripting.FileSystemObject")
' Microdoft Scripting Runtimeの参照は必要なし
' コードの自動補完ができない
' 実行スピードが遅い

Debug.Print FSO2.GetFolder("C:\work").Files.Count

Set FSO1 = Nothing
Set FSO2 = Nothing

'事前バインディングのほうが優秀だが、ユーザの環境によっては参照設定の変更をしてもらわないといけない
'開発時に自動補完が使えるかどうかは、効率にかなり影響する

End Sub


Sub bbb()

'ユーザに参照設定の変更をさせないことを優先とする場合は、以下のようにすると良いかも

#If ENVIROMENT = 0 Then  '開発時のためのコード
  Dim FSO1 As FileSystemObject
  Set FSO1 = New FileSystemObject
  
#Else   '運用時のコード
  Dim FSO1 As Object
  Set FSO1 = CreateObject("Scripting.FileSystemObject")
#End If


Debug.Print FSO1.GetFolder("C:\work").Files.Count

Set FSO1 = Nothing

End Sub

VBEのショートカット一覧　　なるべく覚えたい

*******  メニューに無いもの  *************

Ctrl + ↓        次のプロシージャ
Ctrl + ↑        前のプロシージャ
Ctrl + PageDown  1 画面下へ
Ctrl + PageUp    1 画面上へ
Ctrl + Home      モジュールの先頭に移動する
Ctrl + End       モジュールの最後に移動する
Ctrl + →        右の単語に移動する
Ctrl + ←        左の単語に移動する
End              行末に移動する
Home             行頭に移動する
Ctrl + Y         現在行の切り取り
Ctrl + Del       単語の最後までを削除する
Shift + F10      ショートカット メニューの表示



*******  ファイル  *************

Ctrl + S    上書き保存
Ctrl + M    ファイルのインポート
Ctrl + E    ファイルのエクスポート
Ctrl + P    印刷
Alt + Q     終了してMicrosoft Excelへ戻る



*******  編集  *************

Ctrl + Z           元に戻す
Ctrl + X           切り取り
Ctrl + C           コピー
Ctrl + V           貼り付け
Del                クリア
Ctrl + A           すべて選択
Ctrl + F           検索
F3                 次を検索
Ctrl + H           置換
Tab                インデント
Shift + Tab        インデントを戻す
Ctrl + J           プロパティ/メソッドの一覧
Ctrl + Shift + J   定数の一覧
Ctrl + I           クイック ヒント
Ctrl + Shift + I   パラメーター ヒント
Ctrl + Space       入力候補



*******  表示  *************

F7                  コードの表示
Shift + F7          オブジェクト
Shift + F2          定義　※カーソルをプロシージャ名に置いてShift + F2  で、そこへジャンプ
Ctrl + Shift + F2   元の位置へ移動　Shift + F2 とセットで使う
F2     オブジェクト ブラウザ
Ctrl + G            イミディエイト ウィンドウ
Ctrl + L            呼び出し履歴
Ctrl + R            プロジェクト エクスプローラー
F4                  プロパティ ウィンドウ
Alt + F11           Microsoft Excel



*******  デバッグ  *************

F5                  Sub/ユーザー フォームの実行
F8                  ステップ イン
Shift + F8          ステップ オーバー
Ctrl + Shift + F8   ステップ アウト
Ctrl + F8           カーソルの前まで実行
Ctrl + W            ウォッチ式の編集
Shift + F9          クイック ウォッチ
F9                  ブレークポイントの設定/解除
Ctrl + Shift + F9   すべてのブレークポイントの解除
Ctrl + F9           次のステートメントの設定

VBEの便利機能

****************　ショートカット　　**************

・プロパティ・メソッドの一覧　　ショートカット Ctrl + J

Application.ScreenUpdating = False  というコードがあって
ScreenUpdatingにカーソルを置き、プロパティ・メソッドの一覧を押すと、
Application.以下の候補が表示される。自動補完と同じ



・定数の一覧　　ショートカット Ctrl + Shift + J

Application.ScreenUpdating = False  というコードがあって
Falseにカーソルを置き、定数の一覧一覧を押すと、
ScreenUpdating =で選択できる定数が表示される。自動補完と同じ　　
Long型の変数など、代入できる値が広範囲のものは意味なし。値が限定されているものに使うといい



・オブジェクトの情報取得　　ショートカット Shift + F2

オブジェクトの上にカーソルを置いて、右クリックメニューの「定義」を選択、もしくはShift + F2
オブジェクトブラウザが起動する



・各プロシージャのコードへジャンプ、元の位置に戻る　　ショートカット Shift + F2、Ctrl + Shift + F2

Call プロシージャ名 のコードで、プロシージャ名の上にカーソルを置いて、右クリックメニューの「定義」を選択、もしくはShift + F2
そのプロシージャのコードへジャンプする
「元の位置に戻る」を選択、もしくはCtrl + Shift + F2で、ジャンプする前の位置に戻る



・Ctrl + ↓　で次のプロシージャへ移動、Ctrl + ↑　で前のプロシージャへ移動




****************    イミディエイトウィンドウ   ************************

?strconv("あいう",vbKatakana)　のように、簡単な関数の結果を確認できる

?long1  で、変数long1の値を確認できる。これはステップ実行時に使うだろうか

?Module1.func1　で、func1関数の戻り値を確認できる


Dim i As Long
For i = 1 To 10
  Debug.Print i
Next i

上記のコードをステップ実行中に、
i=5  とイミディエイトに入力すると、iの値を変更できる
モジュールレベルの変数の場合は、Module1.longX=5 のように指定する


range("A1").Value="ABC"　で、セルの値を設定できる

Sub01　で、Sub01プロシージャを実行できる


Application.ScreenUpdating = True　で、画面表示の切り替えを有効に
※VBAが途中で止まってしまった場合に、画面表示の切り替えが元に戻らないことがある。その場合に有効
DisplayAlerts、EnableEventsにも使える


Dim str1 As String
str1 = "ABC"
Debug.Print "str1単独" & str1
Debug.Print "セミコロンで接続"; str1
Debug.Print "カンマで接続", str1

上記のコードを実行すると、イミディエイトへの出力は以下。カンマは一定の間隔を空けるらしい

str1単独ABC
セミコロンで接続ABC
カンマで接続  ABC

イミディエイトウィンドウの高度な使い方。リンク先参照で

リンク

ウォッチウィンドウを使う

Dim bol1 As Boolean
Dim long1 As Long

bol1 = False
bol1 = True
long1 = 100
long1 = 200

上のようなコードがあり、

「ウォッチ式の追加」で、「式がTrueの時に中断」を選択してbol1を追加する
bol1 = True　のコードが実行された直後に実行が一時停止する

「ウォッチ式の追加」で、「式の値が変化した時に中断」を選択してlong1を追加する
long1 = 100のコードが実行された直後に実行が一時停止する

※デバッグには便利な機能だろう。複数の変数が入っている式も指定可能

名前付きのセル範囲を参照する

'エリア1　　シート「2」に設定した名前付き範囲　A1:B5
'エリア2　　ブックに設定した名前付き範囲  E1:F5

Range("エリア1").Select  '名前を付けた範囲を選択
Range("A10").Select
Worksheets("2").Range("エリア1").Select  'シート名を指定
Range("A10").Select
Range("2!エリア1").Select  'こういう指定も可能
Range("A10").Select
Range("rrr.xlsm!エリア2").Select  'ブックに設定した名前範囲は、これで選択できる

'Range("rrr.xlsm!2!エリア1").Select
'エリア1はシート「2」に設定しているので、これはエラーになる

Worksheets("1").Activate

'アクティブではないシートの名前範囲を選択するとエラーになるが、以下のコードなら大丈夫
Application.Goto Reference:="2!エリア1"


Dim range1 As Range

Set range1 = Range("エリア1")  'RangeにSetもできる
range1.Value = 444

VBAの実行速度を上げるために、無効化すべきもの

Application.ScreenUpdating = False     '描画停止
Application.EnableEvents = False         'イベント抑制
Application.Calculation = xlCalculationManual       '手動計算

EnableEvents = False にする場合は、イベントを発生させる必要の有無を考えること

Filter関数　　配列から条件に合致する要素のみを取り出し、配列に格納する

Sub aaaa()

Dim var4 As Variant
Dim var5 As Variant
Dim var6 As Variant
var4 = Array(1, 2, 3)
var5 = Array("aab", "ABB", "ccc", "ddd", "cde", "CDE")

var6 = Filter(var5, "a", , 1)
' var5の要素のうち、"a" を含む要素のみを取り出してvar6に配列として格納
'第4引数を1にすると、テキストモードで比較する

Call OutputArray(var6)  ' (aab,ABB)    OutputArrayは自作の配列要素を出力するSub

var6 = Filter(var5, "a", , 0)  '第4引数を0にすると、バイナリモードで比較する
Call OutputArray(var6)   ' (aab)

var6 = Filter(var5, "", , 1)  ' 検索文字列を空文字にする
Call OutputArray(var6)  ' (aab,ABB,ccc,ddd,cde,CDE)   検索文字列を空文字にすると、絞込みされない

var6 = Filter(var4, "1", , 1)
Call OutputArray(var6)  ' (1)  要素が数値型でも可能らしい
Debug.Print VarType(var6(0))  ' 8 　文字列型に変換されている


var6 = Filter(var5, "a", False, 1)
' 第3引数をFalseにすると、"a"を含まない要素を取り出す
Call OutputArray(var6)    '(ccc,ddd,cde,CDE)


Dim arr3() As String
arr3 = Filter(var5, "c", , 1)  ' 動的配列に格納することも可能
Call OutputArray(arr3)  ' (ccc,cde,CDE)

End Sub


Sub OutputArray(ByRef var1 As Variant)  ' 配列の内容を出力する
  
  Dim i As Long
  Dim str1 As String
  
  str1 = "("
  For i = LBound(var1) To UBound(var1)
    str1 = str1 & var1(i) & ","
  Next i
  str1 = Mid$(str1, 1, Len(str1) - 1) & ")"
  Debug.Print str1

End Sub

Rangeオブジェクトでは、範囲内の行番号と列番号の指定だけでセルを特定できるので、有効活用したい

Dim range1 As Range
Dim i As Long
Dim j As Long
Dim v As Long

'10行10列まで値を入れる
Range(Cells(1, 1), Cells(10, 10)).Clear
v = 1
For i = 1 To 10
  For j = 1 To 10
    Cells(i, j).Value = v
    v = v + 1
  Next j
Next i

Set range1 = Range(Cells(3, 3), Cells(8, 8))  'Rangeの範囲を指定
range1.Font.ColorIndex = 4

Debug.Print range1(2, 5).Value  'Rangeオブジェクト内の行番号・列番号で指定が可能   37

Debug.Print range1(1, 1).Value         '23  range1の左上端の値
Debug.Print range1(Cells(1, 1)).Value  '23  これは一致するのだが

Debug.Print range1(2, 3).Value         '35  これは正しい値を取得できている
Debug.Print range1(Cells(2, 3)).Value  '43  ？　全然違うアドレスの値

range1(3, 3).Interior.Color = RGB(0, 0, 255)
Debug.Print range1(3, 3).Interior.Color  '16711680

Debug.Print "----------------------"

Debug.Print range1.Count    'セルの合計数   36
Debug.Print range1.Rows.Count     '行数  6
Debug.Print range1.Columns.Count  '列数  6
Debug.Print range1(range1.Rows.Count, range1.Columns.Count).Value  '右下端のセル  78

'※　range1(Cells(1, 1)).Value　という書き方は良くないから使わない

ブックやシートのイベント活用例

**************   ブックのイベント   *********************

'シートを追加時に、追加できないようにする
Private Sub Workbook_NewSheet(ByVal Sh As Object)
  Application.ScreenUpdating = False  '一応入れておくか
  
  MsgBox "シートの追加はできません"
  
  Application.DisplayAlerts = False
  Sh.Delete  '追加されたシート削除
  Application.DisplayAlerts = True
End Sub


'ウィンドウの大きさを最大に固定する
Private Sub Workbook_WindowResize(ByVal Wn As Window)
  Wn.WindowState = xlMaximized '最大にする
  'このコード自体で、このイベントが発生してしまうので、メッセージを出すと2回表示になってしまう
End Sub






*********************  シートのイベント  *************************

'アクティブになった時に、入力すべきセルを選択しておく
Private Sub Worksheet_Activate()
  Me.Cells(Me.Rows.Count, 1).End(xlUp).Offset(1).Select
  '1列目の、データがある最終行の1つ下のセルを選択
End Sub


'非アクティブになった時に、入力必須のセルの値を確認
Private Sub Worksheet_Deactivate()
  If Me.Cells(2, 4).Value = "" Then
    MsgBox "入力必須の項目が未入力です"
    Me.Activate
  End If
End Sub


'右クリック禁止にする
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  MsgBox "右クリックしないでください", vbExclamation
  Cancel = True  '動作キャンセル
End Sub

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up

ExcelVBA 汎用テクニック

Enumを使って、配列の何番目の要素が何のデータが入るのかを把握しやすくする。2次元配列を使う場合はこれでいきたい

要素の追加・削除などが多い場合には、配列ではなくCollectionを使う

Select Case を使って、判定式に複数の条件を設定する

多重構造野のループになっている場合に、内側のループから外側のループを抜ける例 GoTo文も使って悪いことは無い

シート名やシート番号が変化しても、シートの指定に問題が起きないシートの指定方法

OffsetとResizeを使って、選択しているセル範囲を変更する かなり使える内容

セル範囲の値をVariant型へ格納し、配列として扱う

(3,10)、3行×10列の配列を、行と列を入れ替えてシートに貼り付け、10行×3列の形にする。結構便利

離れている複数のセル範囲を取得する Areas

WorksheetFunctionでは使えない関数(CODE関数等)を、Evaluateを利用して使う

複数のセル範囲(”A1:B2” と "D4:E5" 等)を選択する、複数のセル範囲の共通する部分を取得する方法

Evaluateで、セル範囲や数式の文字列を解釈する

関数を組み合わせた複雑な処理を、途中経過を格納する変数を使って理解しやすくする

よく使う関数(MsgBox等)を、Functionでカスタマイズする

デフォルト値を持つ引数を指定するなど、Function関連の話 Optional、ParamArray

TypeName関数で、オブジェクトの種類を調べる

条件付コンパイル #Const ～ で宣言した定数を、#IF ～ #End If 内だけで使用できるもの

FileSystemObjectオブジェクト等は、事前バインディングと実行時バインディングで少し性質が異なる。開発時は事前バインディングが有利なので、条件付コンパイルを使って切り替えをする方法

VBEのショートカット一覧 なるべく覚えたい

VBEの便利機能

イミディエイトウィンドウの高度な使い方。リンク先参照で

ウォッチウィンドウを使う

名前付きのセル範囲を参照する

VBAの実行速度を上げるために、無効化すべきもの

Filter関数 配列から条件に合致する要素のみを取り出し、配列に格納する

Rangeオブジェクトでは、範囲内の行番号と列番号の指定だけでセルを特定できるので、有効活用したい

ブックやシートのイベント活用例

ExcelVBA 　汎用テクニック

多重構造野のループになっている場合に、内側のループから外側のループを抜ける例　　GoTo文も使って悪いことは無い

OffsetとResizeを使って、選択しているセル範囲を変更する　　かなり使える内容

離れている複数のセル範囲を取得する　Areas

デフォルト値を持つ引数を指定するなど、Function関連の話　Optional、ParamArray

条件付コンパイル　　#Const ～で宣言した定数を、#IF ～ #End If 内だけで使用できるもの

VBEのショートカット一覧　　なるべく覚えたい

Filter関数　　配列から条件に合致する要素のみを取り出し、配列に格納する