VBA リストボックス データを追加する

リストボックスにデータを登録する

エクセルVBAのユーザーフォームのリストボックスに任意のデータを追加する方法です。

関数、メソッドなど

ListBoxコントロールのAddItemメソッドか、RowSourceプロパティかListプロパティを使用します。

１．AddItemメソッド

AddItemはListBox.AddItem 追加する値で記述します。

コード

Private Sub UserForm_Initialize()
    
    ListBox1.AddItem "A"
    ListBox1.AddItem "B"

End Sub

こんな感じで登録されます。


ワークシート上のセルを追加する場合は

Private Sub UserForm_Initialize()
Dim i As Long

    With ListBox1
         For i = 2 To 10
            .AddItem ActiveSheet.Cells(i, 1)
        Next i
    
    End With

End Sub

一列目（＝A列）の１～１０行目の値がリストに追加されました。

2列以上にする場合は、ColumnCountプロパティを指定し、AddItemした後にListプロパティで編集します。

コード

Private Sub UserForm_Initialize()
Dim i As Long

    With ListBox1
         .ColumnCount = 3
         For i = 2 To 10
             .AddItem ""
             .List(.ListCount - 1, 0) = ActiveSheet.Cells(i, 1)
             .List(.ListCount - 1, 1) = ActiveSheet.Cells(i, 2)
             .List(.ListCount - 1, 2) = ActiveSheet.Cells(i, 3)
        Next i
    
    End With

End Sub

Listプロパティは（行,列）形式で0から始まっています。
（1行目の1列目はList(0,0)、1行目2列目はList(0,1)･･･）

２．RowSourceプロパティ

コード

Private Sub UserForm_Initialize()
Dim r As Long

r = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    With ListBox1
         .ColumnCount = 3
        .RowSource = "Sheet1!A2:C" & r
    
    End With

End Sub

r>

関連・類似ページ

ListViewコントロールの方が見せ方やイベント、などの勝手がよくて使いやすいのですが、64bit版のofficeだとサポートされていません。
なので、もし64bitのofficeになってしまってリストビュー的なことがやりたい場合はListBoxで戦うしかなさそうです。
Officeは特別な理由が無い限り32bitがいいと思います･･･。（64bitの方が速度などパフォーマンスが向上するという噂もありますが。）

ListViewコントロール

VBA YouTubeの再生リストのURLを取得

YouTubeの再生リストのURLを取得

VBAを使ってYouTubeの再生リストのURL、タイトルを一括でエクセルシートに作成する方法です。

関数、メソッドなど

InternetExplorer.ApplicationオブジェクトとHTMLDocumentオブジェクトなどを使用します
ユーチューブの場合は直接HTMLDocument内を取得しようとするとうまくいかないので、IEを表示してHTMLドキュメント内を見ていきます。

そのほかには、Cells.Replaceメソッド、For Toのループ処理ぐらいです。

コード

Sub youtube_list()

'ツール→参照設定で「Microsoft HTML Object Library」にチェック入れる

Dim ws As Worksheet, i As Long, n As Long, r As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")

Dim document As Object
Dim objIE As Object
Dim htmlDoc As HTMLDocument
Dim url_list As String

'IEオブジェクトを作成
Set objIE = CreateObject("InternetExplorer.Application")


'inputboxを使用してURLをセット
url_list = InputBox(prompt:="url_list", Default:="")
objIE.Navigate url_list

'IEを表示
objIE.Visible = True

    '読み込むまでの処理
    While objIE.ReadyState <> 4 Or objIE.Busy = True
        DoEvents
    Wend
    
    'objIEで読み込まれているHTMLドキュメントをセット
    Set htmlDoc = objIE.document
  
    With ws
        'ヘッダー
        .Cells(1, 1) = "url"
        .Cells(1, 2) = "tittle"
        
            
            c = 0
            i = 2
            
            For n = 0 To htmlDoc.all.Length - 1
            
                With htmlDoc.all(n)
                    'リンクがあるタグのみ対象
                    If .tagName = "A" Then
                        'urlがあるclass
                        If .className = "pl-video-title-link yt-uix-tile-link yt-uix-sessionlink  spf-link " Then
                            'URL
                            ws.Cells(i, 1) = .outerHTML
                                '余計な部分を削除
                                ws.Cells(i, 1).Replace what:="&*", replacement:="", lookat:=xlPart, MatchCase:=False
                                ws.Cells(i, 1).Replace what:="*watch?v=", replacement:="", lookat:=xlPart, MatchCase:=False
                                
                            ws.Cells(i, 1) = "https://www.youtube.com/watch?v=" & ws.Cells(i, 1)
                            ws.Cells(i, 1).WrapText = False
                            'タイトル
                            ws.Cells(i, 2) = .innerText
                            ws.Cells(i, 2).WrapText = False
                            i = i + 1
                        End If
                    End If
                    
                End With
            
            Next n
            

    End With

'IE閉じる
objIE.Quit

End Sub

以上です。

解説

VBEの標準モジュールにそのまま貼れば動くとは思います。

inputボックスには再生リストのURLをそのままコピペします。（例、https://www.youtube.com/playlist?list=PLvMqQYhs_H1dSCGF20D5jUf_4AaJ50XF1）

再生リストのURLはAタグ（＝リンクタグ）の中にあるので全てのタグの中からAタグを探し

If .tagName = "A" Then

そして、リンクの中でも再生用のURLはclassnameが"pl-video-title-link yt-uix-tile-link yt-uix-sessionlink spf-link "となっているので

 If .className = "pl-video-title-link yt-uix-tile-link yt-uix-sessionlink  spf-link " Then

で目的のURLを探しています。

あと、VBE上でツール→参照設定で「Microsoft HTML Object Library」にチェック入れてVBAでHTMLDocumentを使えるように設定が必要です。

関連・類似ページ

セルの文字列置換

VBA 2017年カレンダー作成

エクセル形式の２０１７年（２０１７年１月～１２月）カレンダーです。
四半期は１月～３月を第１四半期としています。

コード

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") 
    '四半期
     .Cells(i, 9) = Format(.Cells(i, 1), "q") & "Q" 
    End If
 Next i
End With

End Sub

参照・類似ページ

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

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

関連・類似ページ

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

サンプルコード

Sub kyoyu()
    ActiveWorkbook.ProtectSharing
End Sub

実行結果イメージ

解説

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

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

ProtectSharing

前に

Application.DisplayAlerts = False

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

---

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

サンプルコード

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

関連・類似ページ

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

VBA ワークシートの追加

メソッド構文など

VBAでワークシートを追加する方法の解説とサンプルコードなどです。
エクセルのショートカットだと[Shift]＋[F11]と同様ですが、VBAだと追加する位置や数などを指定できます。
Worksheets.Add(Before, After, Count, Type)メソッドです。

追加したシートはActiveSheetになります。

引数一覧

名前	説明	既定値	例
Before	指定したシートの前に追加する	○	Before:=Worksheets(1)
After	指定したシートの後に追加する		After:=Worksheets(1)
Count	追加するシート数	1	Count:=2
Type	ワークシートの種類(XlSheetType)	xlWorksheet	Type:=xlWorksheet

※全ての引数は省略可能です。（アクティブシートの前に1シート追加）

サンプル

Sub wsa()
    'Sheet1の前に１シート追加
    Worksheets.Add before:=Worksheets(1)
    
End Sub

一番後ろのシートに追加するにはWorksheets.Countプロパティを使用します。

Sub wsa()
    '一番後ろのワークシートに追加
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    
End Sub

関連ページ

新しいブック Workbooks.Addメソッド

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

ハイパーリンクの削除

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

関数、メソッドなど

指定範囲.Hyperlinks.Delete
Hyperlinksオブジェクトのdeleteメソッドを使用します。
指定範囲.に削除する範囲のセルやWorksheetなどを選択します。

サンプルコード

Sub SampleHyperlinkDelete()
    '選択している範囲を削除する
    Selection.Hyperlinks.Delete

    'A1セルのリンクを削除する
    Range("A1").Hyperlinks.Delete

    'Sheet1の全てのリンクを削除する
    Worksheets("Sheet1").Hyperlinks.Delete

End Sub

注）一度消すと元に戻らないです。

関連・類似ページ

ハイパーリンクを設定する
ハイパーリンクを開く