VBA 外れ値の検定

外れ値の抽出

VBAを使って任意のデータから外れ値をの検定をします。
今回は外れ値を見つけたらセルの背景色を変え、別のデータテーブルを作成します。
外れ値検出の方法はスミルノフ・グラブス検定を使用します。

サンプルデータ

商品	1月	2月	3月	4月	5月	6月	7月	8月	9月	10月	11月	12月
商品1	24	31	169	58	93	48	83	34	22	20	8	26
商品2	54	79	251	73	55	71	64	54	44	65	41	101
商品3	72	44	189	147	47	34	84	79	50	78	25	422
商品4	114	49	158	182	122	144	154	66	113	161	56	142
商品5	65	19	71	54	80	121	154	21	59	15	62	17
商品6	60	30	107	500	158	-19	134	104	136	600	107	105
商品7	159	200	166	107	142	104	172	15	34	100	149	127
商品8	378	87	161	350	100	74	443	75	41	148	165	79
商品9	281	402	377	375	209	152	446	62	103	105	184	85
商品10	15	139	147	27	18	46	133	78	19	48	57	122
商品11	110	92	68	95	41	96	778	55	51	48	57	64
商品12	72	113	167	84	43	36	120	86	231	77	205	203
商品13	98	380	167	244	22	24	179	34	32	217	532	303
商品14	12	24	263	96	72	36	99	23	75	32	31	27
商品15	8	71	169	15	32	72	40	31	88	34	39	138
商品16	27	6	40	11	116	20	26	74	9	3	47	37
商品17	-2	12	46	54	5	163	116	-7	449	23	54	37
商品18	690	1122	1560	1108	1278	658	1088	984	1037	1357	1578	1241
商品19	952	1186	2190	2116	2262	1580	1259	1574	1814	1443	2	1408
商品20	97	327	285	284	323	34	157	90	251	134	77	146

サンプルデータは上記のような行に商品別、列に月が12か月分展開されているテーブルを使用します。
サンプルデータ

また事前の準備として同ファイルの別シートに「有意点」というシートを追加し下記のテーブルを作成しています。
（サンプルデータにはデータあります。）

検定の有意点α（片側）

n	0.1	0.05	0.025	0.01
3	1.148	1.153	1.154	1.155
4	1.425	1.462	1.481	1.493
5	1.602	1.671	1.715	1.749
6	1.729	1.822	1.887	1.944
7	1.828	1.938	2.02	2.097
8	1.909	2.032	2.127	2.221
9	1.977	2.11	2.215	2.323
10	2.036	2.176	2.29	2.41
11	2.088	2.234	2.355	2.484
12	2.134	2.285	2.412	2.549
13	2.176	2.331	2.462	2.607
14	2.213	2.372	2.507	2.658
15	2.248	2.409	2.548	2.705
16	2.279	2.443	2.586	2.747
17	2.309	2.475	2.62	2.785
18	2.336	2.504	2.652	2.821
19	2.361	2.531	2.681	2.853
20	2.385	2.557	2.708	2.884
22	2.428	2.603	2.758	2.939
24	2.467	2.644	2.802	2.987
26	2.502	2.681	2.841	3.029
28	2.534	2.714	2.876	3.068
30	2.563	2.745	2.908	3.103
35	2.627	2.811	2.978	3.178
40	2.68	2.867	3.036	3.239
50	2.767	2.956	3.128	3.337
60	2.84	3.03	3.2	3.41
80	2.94	3.13	3.31	3.52
100	3.02	3.21	3.38	3.6
150	3.15	3.34	3.52	3.73
200	3.24	3.43	3.6	3.82
300	3.36	3.55	3.72	3.94
400	3.45	3.63	3.8	4.02
500	3.51	3.69	3.86	4.07
1000	3.7	3.87	4.04	4.25

コード

Sub sumigra()

Dim r As Long, i As Long, j As Long, c As Long, n As Long
Dim yuiten As Double, ave As Double, stdev As Double, atai As Double
Dim yuisuijun As Double
Dim wsYui As Worksheet, wsKen As Worksheet
Dim WF As Object

Set WF = WorksheetFunction


Set wsKen = Worksheets("検査")
Set wsYui = Worksheets("有意点")

With wsKen
    '検査シートの有意水準を取得
    yuisuijun = .Cells(2, 1)
    
    '対象アイテム数
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    
    '棄却後データ用
    .Range(.Cells(4, 2), .Cells(r, 13)).Copy Destination:=.Cells(4, 15)
    
    For i = 5 To r
        n = 12 '今回の標本数(=月数)
        '有意点をwsYuiから探す
        With wsYui
            yuiten = WF.Index(.Range(.Cells(2, 1), .Cells(37, 5)), _
                        WF.Match(n, .Range(.Cells(2, 1), .Cells(37, 1)), 0), _
                        WF.Match(yuisuijun, .Range(.Cells(2, 1), .Cells(2, 5)), 0))
        End With
            
        ave = WF.Average(.Range(.Cells(i, 2), .Cells(i, 13)))
        
            If ave = 0 Then GoTo nodata
        
        stdev = WF.stdev(.Range(.Cells(i, 2), .Cells(i, 13)))

        For j = 2 To 13
            If .Cells(i, j + 13) = "" Then GoTo skip0
            'コピー先で処理する(+13)
            atai = Abs(.Cells(i, j + 13) - ave) / stdev
             
            If atai > yuiten Then
                .Cells(i, j).Interior.Color = RGB(180, 190, 240)
                .Cells(i, j + 13) = ""
                    '平均値再計算
                    ave = WF.Average(.Range(.Cells(i, 15), .Cells(i, 26)))
                    If ave = 0 Then GoTo nodata
                    stdev = WF.stdev(.Range(.Cells(i, 15), .Cells(i, 26)))
                    
                    'nが減るので再び
                    n = n - 1
                    '有意点をwsYuiから探す
                    With wsYui
                        yuiten = WF.Index(.Range(.Cells(2, 1), .Cells(37, 5)), _
                                    WF.Match(n, .Range(.Cells(2, 1), .Cells(37, 1)), 0), _
                                    WF.Match(yuisuijun, .Range(.Cells(2, 1), .Cells(2, 5)), 0))
                    End With
                    
                    '再び検定する
                    j = 1
                    
                    
            End If
        
skip0:
        Next j
        
nodata:
    
    Next i

End With


End Sub

実行すると

が

のようになります。

解説

検定で外れ値が検出されるたら、再び外れ値を除いたデータで検定をしています。
セル(2,1)のの有意水準を変えると有意点が変わります
（有意水準は0.01,0.25,0.5,0.1の4つどれか）

列数を増やしたり減らしたりでコードの値も変更しなければいけないです。

関連・類似ページ

最終セルの取得
セルのコピー
WorksheetFunction.Match
変数一覧

VBA グラフ範囲の変更

グラフのデータ範囲 変更

VBAを使って既存のグラフのデータ範囲を変更する方法です。
エクセル上だと[グラフ右クリック]→[データの選択(E)...]→から各項目を編集していく・・・と同じ動作を再現します。

関数、メソッドなど

ChartオブジェクトのSeriesCollectionメソッドを使用します。
SetSourceDataメソッドを使用したりなど複数のやり方があるみたいですが

エクセル上でグラフの部分をクリックした際に数式バーに表示されるSERIES関数の値を変更するのが楽だと思います。
ChartObjects.Chart.SeriesCollection.FormulaR1C1"=SERIES()"
もしくは
ChartObjects.Chart.SeriesCollection.Formula"=SERIES()"

SERIES関数内は
SERIES(凡例項目,横軸ラベル,値,順番) となっています。

値と順番は必須です。
順番はグラフのプロットの番号で１から順に自動的に割り当てられています。

サンプルコード

○FormulaR1C1の場合

Sub gra()
    'アクティブシートのグラフ(1)
    With ActiveSheet.ChartObjects(1)
        'プロット(1)のSERIESを変更
        .Chart.SeriesCollection(1).FormulaR1C1 = "=SERIES(g!R1C2,g!R2C1:R5C1,g!R2C2:R5C2,1)"
    End With
    
End Sub

○Formulaの場合

Sub gra()
    'アクティブシートのグラフ(1)
    With ActiveSheet.ChartObjects(1)
        'プロット(1)のSERIESを変更
        .Chart.SeriesCollection(1).Formula = "=SERIES(g!$B$1,g!$A$2:$A$5,g!$B$2:$B$5,1)"
    End With
    
End Sub

解説

上記サンプルでは元のグラフに1月部分を追加しています。
どちらのサンプルでも同じ結果になります。

FormulaR1C1形式の方が列を変数として扱いやすいので便利な気がします。

サンプルコード 2

Sub test()
Dim c As Long, r As Long
    
    r = 5 '行
    c = 2 '列

    With ActiveSheet.ChartObjects(1)
        .Chart.SeriesCollection(1).FormulaR1C1 = _
        "=SERIES(g!R1C2,g!R2C1:R5C1,g!R2C2:R" & r & "C" & c & ",1)"
    End With
    
End Sub

関連・類似ページ

エクセル PDFファイルの挿入

PDFファイルの挿入

画像の挿入のように、エクセルにPDFファイルを挿入する方法です。
今のことろExcel2010以上で出来るのは確認しています。

手順

１．リボンにある[挿入]の[オブジェクト]

２．[新規作成]タブにある[Adobe Acrobat Document]

３．ファイルを選択する

・・・で、挿入されます。

ただ、妙に動きが重かったり
挿入するファイルが大きい場合？かページ数が多い場合？かわかりませんが

「別のプログラムでのoleの操作が完了するまで待機します。 」
というメッセージが出続けてタスクマネージャで消さないとどうしようもなくなってしまったりするので
PDFをjpgなどの画像に変換してから
[挿入]→[図]などの方法の方がやりやすい気がします・・。

PDFの画像変換はwebで「PDF pdf 画像変換」とかで検索すると無料のwebサービスが出てきます。

VBA ハイパーリンクの設定

ハイパーリンクの挿入

VBAを使ってセルにハイパーリンクを挿入する方法です。
エクセル上だと[セル右クリック]→[ハイパーリンク(I)...]→[ハイパーリンクの挿入]・・・と同じ動作を再現します。

関数、メソッドなど

HyperlinksオブジェクトのAdd メソッドを使用します。

Hyperlinks.Add(Anchor, Address, SubAddress, ScreenTip, TextToDisplay)

AnchorとAddressは必須です。
Anchorとはハイパーリンクを設定する対象でセルやオブジェクトが入ります。
Addressは、そのままの意味で開く先のアドレスです。ワークブックやＵＲＬなどです。

サンプルコード

Sub hl()
    'セルA1にハイパーリンクを設定
    With ActiveSheet
            .Hyperlinks.Add Anchor:=.Range("a1"), _
            Address:="https://excwlvba.blogspot.jp/"
    End With
    
End Sub

解説

上記サンプルではアクティブシートにハイパーリンクの設定をしています。

○パラメーター

名前	必須/オプション	説明
Anchor	必須	ハイパーリンクのアンカーを指定 Range オブジェクトまたは Shape オブジェクトを指定
Address	必須	ハイパーリンクのアドレス
SubAddress	オプション	サブアドレス （ブックの場合シートやセルなど）
ScreenTip	オプション	ハイパーリンク上をマウスポインターで指した場合に表示されるヒント
TextToDisplay	オプション	ハイパーリンクで表示されるテキスト

サンプルコード 2

Sub hl()
    'セルA1にハイパーリンクを設定
    With ActiveSheet
            .Hyperlinks.Add Anchor:=.Range("a1"), _
            Address:="https://excwlvba.blogspot.jp/", _
            ScreenTip:="マウスオーバーで表示される文字", _
            TextToDisplay:="セルに表示する文字"
    End With
    
End Sub

サンプルコード 3

Sub hl()
    '別のワークブックをリンク先として設定
    With ActiveSheet
            'セルA1にハイパーリンク挿入
            .Hyperlinks.Add Anchor:=.Range("a1"), _
            Address:="F:\test\book1.xlsx", _
            SubAddress:="Sheet2!A2", _
            TextToDisplay:="セルに表示する文字"
    End With
        
        'リンク先は[F:\test\]にある[book1.xlsx]
        'book1.xlsxのSheet2!A2をアクティブにし選択
        
End Sub

関連・類似ページ

ハイパーリンクを開く
ハイパーリンクを削除する

VBA オートフィルタの件数表示

AutoFilterで抽出したデータ数をカウントする

VBAを使ってオートフィルタで抽出したデータ数をカウントする方法です。
また、表示されている最終行番号も取得します。

関数、メソッドなど

XlCellTypeの定数を使用します。
Range.SpecialCells(xlCellTypeVisible).Count
指定したセルの範囲（Range）に対して表示されているセル（xlCellTypeVisible）をカウントします。

サンプルコード

Sub autosu()
Dim r As Long '最終行用
Dim countdata As Long 'データ数カウント用

'最終行を取得
r = Cells(Rows.Count, 1).End(xlUp).Row

'B列が東証1部のものを抽出
Range("a1").AutoFilter Field:=2, Criteria1:="東証1部"

'表示されているデータ数を取得
countdata = Range(Cells(2, 1), Cells(r, 1)).SpecialCells(xlCellTypeVisible).Count

    MsgBox countdata

End Sub

解説

まずはテーブルにある最終行番号を取得し、変数rに格納します。
オートフィルタでデータ抽出後にテーブル範囲全体行に対して、表示されている行数をカウントします。

ただ、抽出されたデータ数が0の場合、

「実行時エラー'1004';
　該当するセルが見つかりません。」

というエラーが出てしまいます。
これを回避するために

Range.SpecialCells(xlCellTypeLastCell)

で、抽出されたデータの最終行を調べてから分岐させます。

Sub autosu2()
Dim r As Long '最終行用
Dim r1 As Long
Dim countdata As Long 'データ数カウント用

'最終行を取得
r = Cells(Rows.Count, 1).End(xlUp).Row

'B列が東証1部のものを抽出
Range("a1").AutoFilter Field:=2, Criteria1:="東証3部"

'表示されているデータの最終行を取得
r1 = Range("A1").SpecialCells(xlCellTypeLastCell).Row


If r1 = 1 Then
    countdata = 0
Else
    '表示されているデータ数を取得
    countdata = Range(Cells(2, 1), Cells(r, 1)).SpecialCells(xlCellTypeVisible).Count
End If


    MsgBox countdata

End Sub

---

関連・類似ページ

XlCellType列挙
値の入っているセルのみを選択
最終セルの取得

VBA 数式の挿入

数式の挿入

VBAを使ってセルに数式を入力する方法です。
VBA処理で計算するのではなくエクセルシートに数式を残します。

関数、メソッドなど

FormulaプロパティとFormulaR1C1プロパティの2種類で実行できます。
Range.Formula = "=A2+B2"
Range("A1").FormulaR1C1 = "=R2C1+R2C2"
「Formula =」以降はダブルクォーテーションで囲った中に「=数式」という形式で記述します。

「Formula =」以降変数を使用する場合はCells形式とAddressプロパティを使用します。

サンプルコード

Sub formula1()
Dim a As Long, b As Long
    
    'そのまま数式を直接
    Range("A1").Formula = "=A2+B2"
    '変数使う場合
    a = 1
    b = 2
    Range("A1").Formula = "=" & Cells(b, a).Address & "+" & Cells(b, b).Address
End Sub

解説

上記サンプルでは両方ともA1セルにA2+B2を入力しています。
（Cells形式+Addressだと既定値は絶対参照になるので"=$A$2+$B$2"になっています。
絶対参照ではなく相対参照にするには

        Range("A1").Formula = "=" & Cells(b, a).Address(RowAbsolute:=False, ColumnAbsolute:=False) & _
     "+" & Cells(b, b).Address(RowAbsolute:=False, ColumnAbsolute:=False)

としてAddressプロパティのRowAbsoluteとColumnAbsoluteをFalseにします。）

○その他
・「Formula =」あと["=…"]の[=]を入れないと文字列として扱われます。

・エクセル関数を使用する場合も基本的に同じです。

Sub formula2()
    Range("A1").Formula = "=sum(A2,B2)"
    Range("A1").Formula = "=sum(" & Cells(b, a).Address & "+" & Cells(b, b).Address & ")"
End Sub

VBA データの入力規則の設定

データの入力規則

VBAを使ってセルの入力規則を設定する方法です。
エクセル上だと[リボン]→[データ]→[データの入力規則]→・・・と同じ動作を再現します。

関数、メソッドなど

Range.Validationプロパティを使用し、Validationオブジェクトを設定します。
Range.Validation.Add(Type, AlertStyle, Operator, Formula1, Formula2)
最初設定するにはAddメソッドを使用します。

サンプルコード

Sub kisoku()
    'セル(I1:I4)に入力規則設定
    With Range(Cells(1, 9), Cells(4, 9)).Validation
        .Add Type:=xlValidateList, _
             Operator:=xlEqual, _
             Formula1:="=$A$1:$A$7"
    End With
End Sub

エクセルでの同じ設定をした場合は↓のような感じです。

解説

上記サンプルはリスト型で同一シート内にあるA1:A7の範囲を入力規則になるよう設定しています。 Validation.Addで入力規則の設定を開始しており、
Type:=は「リスト」や「整数」などのタイプの指定
Operator:=は「等しい」や「以上」など値の範囲などの指定
Formula1:=は元の値になるデータを選択しています。

Type以降に指定するプロパティはTypeプロパティの値によって異なります。

○Type 列挙

名前	内容	値
xlValidateCustom	ユーザー設定	7
xlValidateDate	日付	4
xlValidateDecimal	小数点数	2
xlValidateInputOnly	すべての値	0
xlValidateList	リスト	3
xlValidateTextLength	文字列（長さ指定）	6
xlValidateTime	時刻	5
xlValidateWholeNumber	整数	1

種類です。

○Operator 列挙

名前	内容	値
xlBetween	二つの数式の範囲	1
xlNotBetween	二つの数式の範囲外	2
xlEqual	等しい	3
xlNotEqual	等しくない	4
xlGreater	より大きい	5
xlLess	より小さい	6
xlGreaterEqual	以上	7
xlLessEqual	以下	8

値の範囲です。

○AlertStyle 列挙

名前	内容	値
xlValidAlertInformation	情報	3
xlValidAlertStop	停止	1
xlValidAlertWarning	注意	2

エラーメッセージのアイコンです。



○Formula1、Formula2は必要に応じて値を入力します。

---

データの入力規則の削除

メソッドなど

Range.Validation.Delete

サンプルコード（パスワード設定なし）

Sub kisoku_del()
    'セル(I1:I4)に入力規則削除
    With Range(Cells(1, 9), Cells(4, 9)).Validation
        .Delete
    End With
End Sub

VBA シートの保護（保護の解除）

シートの保護

VBAを使ってエクセルシートの保護をする方法とその解除方法です。
エクセル上だと[リボン]→[校閲]→[シートの保護]→・・・と同じ動作を再現します。

メソッドなど

Worksheet.Protect

サンプルコード（パスワード設定なし）

Sub hogo()
    'アクティブシートの保護
    ActiveSheet.Protect    
End Sub

実行結果イメージ

解説

例としてActiveSheetに対してシートの保護をする処理をしています。

WoekrSheet.Protectはワークシートを保護するメソッドです。
[校閲]から[シートの保護]を選択すると出てくるオプション設定する「パスワード」や「セルの選択の許可」などのパラメータはProtectの後に記述することで指定できます。

パラメータ一覧

名前	内容	値	既定値
Contents	シートとロックされたセルの内容の保護	True/False	True
Password	パスワード	文字列
AllowFormattingCells	セルの書式設定	True/False	False
AllowFormattingColumns	列の書式設定	True/False	False
AllowFormattingRows	行の書式設定	True/False	False
AllowInsertingColumns	列の挿入	True/False	False
AllowInsertingRows	行の挿入	True/False	False
AllowInsertingHyperlinks	ハイパーリンクの挿入	True/False	False
AllowDeletingColumns	列の削除	True/False	False
AllowDeletingRows	行の削除	True/False	False
AllowSorting	並び替え	True/False	False
AllowFiltering	オートフィルタの使用	True/False	False
AllowUsingPivotTables	ピボットテーブル レポートを使用する	True/False	False
DrawingObjects	オブジェクトの編集	True/False	True
Scenarios	シナリオの編集	True/False	True
UserInterfaceOnly	画面上からの変更保護	True/False	False

Contentsの動きがいまいちよくわかりませんがFalseにするとロックしたセルも編集できました。（オブジェクトとグラフは編集不可のままっぽい）

---

サンプルコード（パスワード設定など）

Sub hogo()
    'アクティブシートの保護(パスワード指定、並び替え許可）
    ActiveSheet.Protect Password:="123", AllowSorting:=True
End Sub

シートの保護の解除

メソッドなど

Worksheet.Protect

サンプルコード（パスワード設定なし）

Sub hogokaijo()
    'アクティブシートの保護解除
    ActiveSheet.Unprotect
End Sub

パスワード設定がある場合は引数Passwordに指定します。

    ActiveSheet.Unprotect Password:="123"

関連・類似ページ

ブックの共有化
ブックの保存
警告や確認メッセージを非表示にする

VBA ブックの共有の解除

VBAを使ってエクセルブックのの共有の解除をする方法です。
エクセル上だと[リボン]→[校閲]→[ブックの共有]→[複数ユーザーによる同時編集と、ブックの結合を許可する]のチェックを外すことと同じ動作を再現します。

ステートメント構文など

WorkBook.UnprotectSharing(SharingPassword)

WorkBook.ExclusiveAccess

サンプルコード（パスワード設定なし）

Sub kyoyu()
    ActiveWorkbook.UnprotectSharing
    ActiveWorkbook.ExclusiveAccess
End Sub

実行結果イメージ

解説

例としてActiveWorkbookに対して共有の解除をする処理をしています。

UnprotectSharingは共有保護を解除しブックを保存するメソッドです。
が、
単体だとなぜか動きません。
そこでExclusiveAccessで共有ファイルとして開いているブックを他のユーザーが変更できないようにしています。

この二つのメソッドを実行すると保護の解除の処理にすすみます。
「このブックの保護を解除すると、ファイルの変更の履歴が削除されます。また、共有を無効にすると、上書きせずにこのファイルを保存することはできなくなります。このファイルの保護を解除してもよろしいですか？」

というコメントが出て、「はい」か「いいえ」を選択し「はい」の場合は保護を解除します。
このアラートを出したくない場合は事前にApplication.DisplayAlerts = Falseと記述しておけば、 アラートなしで共有化が解除になります。

---

サンプルコード（共有パスワード設定あり）

Sub kyoyu()
    ActiveWorkbook.UnprotectSharing Sharingpassword:="1234"
End Sub

解説

UnprotectSharingのパラメータSharingpasswordを記述することによって エクセル上でいう「ブックの保護と共有」の「共有の解除」を実行します。
これで終わりです。

この場合はExclusiveAccessを記述していると
「ExclusiveAccessメソッドは失敗しました」というエラーが出てしまうので記述はいらないみたいです。

関連・類似ページ

ブックの共有化
ブックの保存
警告や確認メッセージを非表示にする

VBA ブックの共有化

VBAを使ってエクセルブックのの共有をする方法です。
エクセル上だと[リボン]→[校閲]→[ブックの共有]で同じ動作を再現します。

ステートメント構文など

WorkBook.ProtectSharing

サンプルコード

Sub kyoyu()
    ActiveWorkbook.ProtectSharing
End Sub

実行結果イメージ

解説

例としてActiveWorkbookに対して共有する処理をしています。
エクセル上で冒頭にあるような共有の仕方をする時もそうですが、共有しようとすると

「この操作を行うと、ブックはいったん保存されます。よろしいですか？」
というコメントが出て、「ＯＫ」か「キャンセル」を選択しないと処理が進まなくなります。
このアラートを出したくない場合は

ProtectSharing

前に

Application.DisplayAlerts = False

と記述しておけば、 アラートなしで共有化が出来るようになります。

---

パスワード設定をする場合（エクセル上の「ブックの保護と共有」）はProtectSharingのパラメーターSharingPasswordを指定します。

サンプルコード

Sub kyoyu()
    ActiveWorkbook.ProtectSharing  Sharingpassword:="1234"
End Sub

関連・類似ページ

ブックの共有の解除
ブックの保存
警告や確認メッセージを非表示にする

VBA セルをダブルクリックしたらイベントを実行する

ステートメント構文など

Worksheet_BeforeDoubleClick

VBAを使ってエクセル上でセルをダブルクリックしたら何かしらVBAで処理をする方法です。
コードを記述する場所は[Microsoft Excel Objects]の中の実行したいワークシート（Sheet1(Sheet1)）などです。

サンプルコード

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'セルのA2:A5の範囲がダブルクリックされた時を対象
    If Not Intersect(Target, Range("A2:A5")) Is Nothing Then
        '処理例～～
        Cells(Target.Row, 2).Select
        MsgBox (Cells(Target.Row, 3))
    End If

End Sub

実行結果イメージ（セルA3をダブルクリックしています）

解説

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

セルをダブルクリックしたときに発生するイベントです。
クリックしたセルが引数[Target]となります。

If Not Intersect(Target, Range("A2:A5")) Is Nothing Then

Range("A2:A5")の範囲の場合を対象として処理をしようとしています。
Intersectは「横切る」の意味で「指定した範囲ではなくない場合ならば」という2重否定になっています。


引数[Target]にはクリックした行や列の情報が入っているので

Target.Row

で行番号が

Target.Column

で列番号が取得できます。

Cells(Target.Row, 2).Select

は一応クリックしたセルが編集モードにならないように隣のセルを選択しています。

関連・類似ページ

プロシージャを呼び出す

関連にある「Callステートメント」と併用することで色々と用途の幅は広がると思います。

VBA 文字の改行

ステートメント構文など

vbCrLf

VBAを使ってエクセル上で、もしくはフォームやメッセージボックスなどで改行する方法です。
エクセル上だとセルの編集中に[Alt+Enter]と同じ動作を再現します。

サンプルコード

Sub kaigyo()
    Cells(1, 1) = "かいぎょう" & vbCrLf & "テスト1"
    Cells(1, 2) = "かいぎょう" & vbLf & "テスト2"
    Cells(1, 3) = "かいぎょう" & vbCr & "テスト3"
    Cells(1, 4) = "かいぎょう" & Chr(10) & "テスト4"
    Cells(1, 5) = "かいぎょう" & Chr(13) & "テスト5"
    Cells(1, 6) = "かいぎょう" & vbNewLine & "テスト6"
    
    Debug.Print "かいぎょう" & vbCrLf & "テスト1"
    Debug.Print "かいぎょう" & vbLf & "テスト2"
    Debug.Print "かいぎょう" & vbCr & "テスト3"
    Debug.Print "かいぎょう" & Chr(10) & "テスト4"
    Debug.Print "かいぎょう" & Chr(13) & "テスト5"
    Debug.Print "かいぎょう" & vbNewLine & "テスト6"

End Sub

実行結果イメージ

解説

vbLf（定義済みの定数）

Chr(10)（実際の値）

この二つは「ラインフィード」の略で原則的には1行下に移る動作をします。

vbCr（定義済みの定数）

Chr(13)（実際の値）

この二つは「キャリッジ・リターン」の略で原則的にカーソルなどを同一行の先頭位置に移動します。

ラインフィードとキャリッジ・リターンを合わせて

vbCrLf （定義済みの定数）

Chr(13)&（Chr(10)実際の値）

で改行を表すのが通常っぽいですが
VBA上であれば

vbNewLine (定義済みの定数）

で思うような動作が得られると思います。

関連・類似ページ

セルの文字列置換Replace

2016年度カレンダー エクセル(VBA)

エクセル形式の2016年4月～2017年3月のカレンダーです。
四半期は4月～6月を第１四半期としています。

コード

Sub calenddd()
Dim ws As Worksheet, i As Long
Dim firstDay As Date

'inputボックスに一日目を入力
firstDay = InputBox(Date, "最初の日", "YYYY/MM/DD")

Set ws = Worksheets(1)
    
With ws
 For i = 2 To 367 '閏年対策でめんどいので余分にとっておく
       
  If i <> 2 Then
   .Cells(i, 1) = Format(.Cells(i - 1, 1) + 1, "YYYY/MM/DD")
  Else
   .Cells(i, 1) = Format(firstDay, "YYYY/MM/DD")
  End If
     
    'スラッシュない形式
     .Cells(i, 2) = Format(.Cells(i, 1), "YYYYMMDD") 
    '曜日(略
     .Cells(i, 3) = Format(.Cells(i, 1), "aaa") 
    '曜日(フル
     .Cells(i, 4) = Format(.Cells(i, 1), "aaaa")
    'Yobi(Ryaku 
     .Cells(i, 5) = Format(.Cells(i, 1), "ddd") 
    'Yobi(Full
     .Cells(i, 6) = Format(.Cells(i, 1), "dddd")
    '和暦 
     .Cells(i, 7) = Format(.Cells(i, 1), "ggg") 
    '年月
     .Cells(i, 8) = Format(.Cells(i, 1), "YYYYMM") 
        
    If Format(.Cells(i, 1), "q") = 1 Then
     '四半期
     .Cells(i, 9) = 4 & "Q" 
    Else
     '四半期
     .Cells(i, 9) = Format(.Cells(i, 1), "q") - 1 & "Q" 
    End If
 Next i
End With

End Sub

作成後のエクセルファイルはこちらです。
2016年度カレンダー

参照・類似ページ

日付表示書式指定（Format）関数
日付を取得する(Date)関数
年月日計算値（シリアル値）を取得する(DateSerial)関数

2016年カレンダー エクセル(VBA)

エクセル形式の2016年1月～2016年12月のカレンダーです。
四半期は4月～6月を第１四半期としています。

コード

Sub calenddd()
Dim ws As Worksheet, i As Long
Dim firstDay As Date

'inputボックスに一日目を入力
firstDay = InputBox(Date, "最初の日", "YYYY/MM/DD")

Set ws = Worksheets(1)
    
With ws
 For i = 2 To 367 'めんどいので余分にとっておく
       
  If i <> 2 Then
   .Cells(i, 1) = Format(.Cells(i - 1, 1) + 1, "YYYY/MM/DD")
  Else
   .Cells(i, 1) = Format(firstDay, "YYYY/MM/DD")
  End If
     
    'スラッシュない形式
     .Cells(i, 2) = Format(.Cells(i, 1), "YYYYMMDD") 
    '曜日(略
     .Cells(i, 3) = Format(.Cells(i, 1), "aaa") 
    '曜日(フル
     .Cells(i, 4) = Format(.Cells(i, 1), "aaaa")
    'Yobi(Ryaku 
     .Cells(i, 5) = Format(.Cells(i, 1), "ddd") 
    'Yobi(Full
     .Cells(i, 6) = Format(.Cells(i, 1), "dddd")
    '和暦 
     .Cells(i, 7) = Format(.Cells(i, 1), "ggg") 
    '年月
     .Cells(i, 8) = Format(.Cells(i, 1), "YYYYMM") 
        
    If Format(.Cells(i, 1), "q") = 1 Then
     '四半期
     .Cells(i, 9) = 4 & "Q" 
    Else
     '四半期
     .Cells(i, 9) = Format(.Cells(i, 1), "q") - 1 & "Q" 
    End If
 Next i
End With

End Sub

作成後のエクセルファイルはこちらです。
2016年カレンダー

参照・類似ページ

日付表示書式指定（Format）関数
日付を取得する(Date)関数
年月日計算値（シリアル値）を取得する(DateSerial)関数