【VBA】オートフィルタを使用して表からデータを抽出する
<機能>
(1)アクティブシートにテスト用の表を作成します
※出典 外務省「海外在留邦人数調査統計 (平成27年要約版)」
(2)AutoFilterメソッドを使用して表からデータを抽出します
・在留邦人数が10000人以上の国
・国名が英国、ボリビア、ネパール
・国名に「国」が含まれている
・国名に「国」が含まれていて、かつ在留邦人数が50000人以上(複数列条件)
・在留邦人数が30000人以上、100000人以下(単一列複数条件)
・在留邦人数が下位15件(36-50位)
・国名が英国、ボリビア、ネパール
・国名に「国」が含まれている
・国名に「国」が含まれていて、かつ在留邦人数が50000人以上(複数列条件)
・在留邦人数が30000人以上、100000人以下(単一列複数条件)
・在留邦人数が下位15件(36-50位)
<動作検証&開発環境>
Microsoft Office 2016
<使い方>
適当なところにソースを張り付けてください
オートフィルタを設定する()を呼び出すと2秒毎に上記抽出を実施します
<実行イメージ>
テスト用の表を自動作成
AutoFilterメソッドで抽出
'********************************************
'VBAでオートフィルタを設定する
'(1)アクティブシートにテスト用の表を作成
'(2)オートフィルタを設定
'(3)在留邦人数が10000人以上の国を抽出
'(4)国名が英国、ボリビア、ネパールのレコードを抽出
'(5)国名に「国」が含まれているレコードを抽出(部分一致)
'(6)国名に「国」が含まれていて、かつ在留邦人数が50000人以上のレコードを抽出(複数列条件)
'(7)在留邦人数が30000人以上、100000人以下のレコードを抽出(単一列複数条件)
'(8)在留邦人数が下位15件(36-50位)のレコードを抽出
'メソッドの引数「Operator」への設定値(XlAutoFilterOperator)は下記参照
'https://msdn.microsoft.com/ja-jp/library/office/ff839625.aspx
'********************************************
Sub オートフィルタを設定する()
Dim gyo As Long
'VBAでオートフィルタを設定する
'(1)アクティブシートにテスト用の表を作成
'(2)オートフィルタを設定
'(3)在留邦人数が10000人以上の国を抽出
'(4)国名が英国、ボリビア、ネパールのレコードを抽出
'(5)国名に「国」が含まれているレコードを抽出(部分一致)
'(6)国名に「国」が含まれていて、かつ在留邦人数が50000人以上のレコードを抽出(複数列条件)
'(7)在留邦人数が30000人以上、100000人以下のレコードを抽出(単一列複数条件)
'(8)在留邦人数が下位15件(36-50位)のレコードを抽出
'メソッドの引数「Operator」への設定値(XlAutoFilterOperator)は下記参照
'https://msdn.microsoft.com/ja-jp/library/office/ff839625.aspx
'********************************************
Sub オートフィルタを設定する()
Dim gyo As Long
'//(1)テストデータ「平成26年海外在留邦人数」表を作成
SetTestData
'//2列目(B列)でデータの入っている最終行を取得
gyo = Cells(Rows.Count, 2).End(xlUp).Row
If gyo < 4 Then
MsgBox "表「国(地域)別在留邦人数上位50位」が見つかりません", vbCritical
Exit Sub
End If
'//(2)オートフィルタを設定する
'//B列(順 位):field1(指定範囲の左から1列目)
'//C列(国 名):field2(指定範囲の左から2列目)
'//D列(邦人数):field3(指定範囲の左から3列目)
SetTestData
'//2列目(B列)でデータの入っている最終行を取得
gyo = Cells(Rows.Count, 2).End(xlUp).Row
If gyo < 4 Then
MsgBox "表「国(地域)別在留邦人数上位50位」が見つかりません", vbCritical
Exit Sub
End If
'//(2)オートフィルタを設定する
'//B列(順 位):field1(指定範囲の左から1列目)
'//C列(国 名):field2(指定範囲の左から2列目)
'//D列(邦人数):field3(指定範囲の左から3列目)
'全ての列のオートフィルタを解除
Range("B3:D" & CStr(gyo)).AutoFilter 1
Range("B3:D" & CStr(gyo)).AutoFilter 2
Range("B3:D" & CStr(gyo)).AutoFilter 3
Range("B3:D" & CStr(gyo)).AutoFilter 1
Range("B3:D" & CStr(gyo)).AutoFilter 2
Range("B3:D" & CStr(gyo)).AutoFilter 3
'//(3)在留邦人数が10000人以上の国を抽出
Cells(2, 2) = "(3)在留邦人数が10000人以上の国を抽出"
'絞込みを実施
Range("B3:D" & CStr(gyo)).AutoFilter Field:=3, Criteria1:=">=10000"
DoEvents
Application.Wait Now + TimeValue("0:00:02")
Cells(2, 2) = "(3)在留邦人数が10000人以上の国を抽出"
'絞込みを実施
Range("B3:D" & CStr(gyo)).AutoFilter Field:=3, Criteria1:=">=10000"
DoEvents
Application.Wait Now + TimeValue("0:00:02")
'//(4)国(地域)名が英国、ボリビア、ネパールのレコードを抽出
Cells(2, 2) = "(4)国(地域)名が英国、ボリビア、ネパールのレコードを抽出"
'先にオートフィルタを解除
Range("B3:D" & CStr(gyo)).AutoFilter 3
'絞込みを実施
Range("B3:D" & CStr(gyo)).AutoFilter Field:=2, _
Criteria1:=Array("英国", "ボリビア", "ネパール"), _
Operator:=xlFilterValues
DoEvents
Application.Wait Now + TimeValue("0:00:02")
Cells(2, 2) = "(4)国(地域)名が英国、ボリビア、ネパールのレコードを抽出"
'先にオートフィルタを解除
Range("B3:D" & CStr(gyo)).AutoFilter 3
'絞込みを実施
Range("B3:D" & CStr(gyo)).AutoFilter Field:=2, _
Criteria1:=Array("英国", "ボリビア", "ネパール"), _
Operator:=xlFilterValues
DoEvents
Application.Wait Now + TimeValue("0:00:02")
'//(5)国(地域)名に「国」が含まれているレコードを抽出(部分一致)
Cells(2, 2) = "(5)国(地域)名に「国」が含まれているレコードを抽出(部分一致)"
'先にオートフィルタを解除
Range("B3:D" & CStr(gyo)).AutoFilter 2
'絞込みを実施
Range("B3:D" & CStr(gyo)).AutoFilter Field:=2, Criteria1:="*国*"
DoEvents
Application.Wait Now + TimeValue("0:00:02")
Cells(2, 2) = "(5)国(地域)名に「国」が含まれているレコードを抽出(部分一致)"
'先にオートフィルタを解除
Range("B3:D" & CStr(gyo)).AutoFilter 2
'絞込みを実施
Range("B3:D" & CStr(gyo)).AutoFilter Field:=2, Criteria1:="*国*"
DoEvents
Application.Wait Now + TimeValue("0:00:02")
'//(6)国名に「国」が含まれていて、かつ邦人数が50000人以上のレコードを抽出(複数列条件)
Cells(2, 2) = "(6)国名に「国」が含まれていて、かつ邦人数が50000人以上のレコードを抽出(複数列条件)"
'先にオートフィルタを解除
Range("B3:D" & CStr(gyo)).AutoFilter 2
'絞込みを実施
Range("B3:D" & CStr(gyo)).AutoFilter Field:=2, Criteria1:="*国*"
Range("B3:D" & CStr(gyo)).AutoFilter Field:=3, Criteria1:=">=50000"
DoEvents
Application.Wait Now + TimeValue("0:00:02")
Cells(2, 2) = "(6)国名に「国」が含まれていて、かつ邦人数が50000人以上のレコードを抽出(複数列条件)"
'先にオートフィルタを解除
Range("B3:D" & CStr(gyo)).AutoFilter 2
'絞込みを実施
Range("B3:D" & CStr(gyo)).AutoFilter Field:=2, Criteria1:="*国*"
Range("B3:D" & CStr(gyo)).AutoFilter Field:=3, Criteria1:=">=50000"
DoEvents
Application.Wait Now + TimeValue("0:00:02")
'//(7)在留邦人数が30000人以上、100000人以下のレコードを抽出(単一列複数条件)
Cells(2, 2) = "(7)在留邦人数が30000人以上、100000人以下のレコードを抽出(単一列複数条件)"
'先にオートフィルタを解除
Range("B3:D" & CStr(gyo)).AutoFilter 2
Range("B3:D" & CStr(gyo)).AutoFilter 3
'絞込みを実施
Range("B3:D" & CStr(gyo)).AutoFilter Field:=3, Criteria1:=">=30000", _
Operator:=xlAnd, Criteria2:="<=100000"
DoEvents
Application.Wait Now + TimeValue("0:00:02")
Cells(2, 2) = "(7)在留邦人数が30000人以上、100000人以下のレコードを抽出(単一列複数条件)"
'先にオートフィルタを解除
Range("B3:D" & CStr(gyo)).AutoFilter 2
Range("B3:D" & CStr(gyo)).AutoFilter 3
'絞込みを実施
Range("B3:D" & CStr(gyo)).AutoFilter Field:=3, Criteria1:=">=30000", _
Operator:=xlAnd, Criteria2:="<=100000"
DoEvents
Application.Wait Now + TimeValue("0:00:02")
'//(8)在留邦人数が下位15件(36-50位)のレコードを抽出
Cells(2, 2) = "(8)在留邦人数が下位15件(36-50位)のレコードを抽出"
'先にオートフィルタを解除
Range("B3:D" & CStr(gyo)).AutoFilter 3
'絞込みを実施
Range("B3:D" & CStr(gyo)).AutoFilter Field:=3, Criteria1:="15", _
Operator:=xlBottom10Items
DoEvents
Application.Wait Now + TimeValue("0:00:02")
Cells(2, 2) = "(8)在留邦人数が下位15件(36-50位)のレコードを抽出"
'先にオートフィルタを解除
Range("B3:D" & CStr(gyo)).AutoFilter 3
'絞込みを実施
Range("B3:D" & CStr(gyo)).AutoFilter Field:=3, Criteria1:="15", _
Operator:=xlBottom10Items
DoEvents
Application.Wait Now + TimeValue("0:00:02")
MsgBox "おわりました", vbInformation
End Sub
End Sub
'********************************************
'シートに「平成26年海外在留邦人数」表を作成する
'出典 外務省「海外在留邦人数調査統計 (平成27年要約版)」
'http://www.mofa.go.jp/mofaj/toko/page22_000043.html
'********************************************
Sub SetTestData()
Dim ar As Variant
ar = Array("順位,国(地域)名 ,在留邦人数", "1,米国,414247", _
"2,中国,133902", "3,オーストラリア,85083", "4,英国,67258", "5,タイ,64285", _
"6,カナダ,63252", "7,ブラジル,54377", "8,ドイツ,39902", "9,フランス,38349", _
"10,韓国,36708", "11,シンガポール,35982", "12,マレーシア,22056", _
"13,フィリピン,18870", "14,台湾,18592", "15,インドネシア,17893", _
"16,ニュージーランド,16705", "17,イタリア,13687", "18,ベトナム,13547", _
"19,アルゼンチン,11675", "20,スイス,10166", "21,メキシコ,9186", _
"22,インド,8313", "23,スペイン,8080", "24,オランダ,6959", _
"25,ベルギー,5402", "26,グアム(ハガッニャ総),4484", "27,ペルー,3585", _
"28,パラグアイ,3554", "29,アラブ首長国連邦,3543", "30,スウェーデン,3302", _
"31,オーストリア,3027", "32,ボリビア,2897", "33,ロシア,2732", _
"34,カンボジア,2270", "35,トルコ,2049", "36,アイルランド,1767", _
"37,フィンランド,1759", "38,チェコ,1750", "39,チリ,1580", _
"40,デンマーク,1509", "41,南アフリカ,1377", "42,コロンビア,1355", _
"43,ミャンマー,1330", "44,ハンガリー,1287", "45,ポーランド,1255", _
"46,ネパール,1095", "47,ノルウェー,1065", "48,エジプト,1019", _
"49,スリランカ,1013", "50,イスラエル及びガザ地区等,997")
'シートに「平成26年海外在留邦人数」表を作成する
'出典 外務省「海外在留邦人数調査統計 (平成27年要約版)」
'http://www.mofa.go.jp/mofaj/toko/page22_000043.html
'********************************************
Sub SetTestData()
Dim ar As Variant
ar = Array("順位,国(地域)名 ,在留邦人数", "1,米国,414247", _
"2,中国,133902", "3,オーストラリア,85083", "4,英国,67258", "5,タイ,64285", _
"6,カナダ,63252", "7,ブラジル,54377", "8,ドイツ,39902", "9,フランス,38349", _
"10,韓国,36708", "11,シンガポール,35982", "12,マレーシア,22056", _
"13,フィリピン,18870", "14,台湾,18592", "15,インドネシア,17893", _
"16,ニュージーランド,16705", "17,イタリア,13687", "18,ベトナム,13547", _
"19,アルゼンチン,11675", "20,スイス,10166", "21,メキシコ,9186", _
"22,インド,8313", "23,スペイン,8080", "24,オランダ,6959", _
"25,ベルギー,5402", "26,グアム(ハガッニャ総),4484", "27,ペルー,3585", _
"28,パラグアイ,3554", "29,アラブ首長国連邦,3543", "30,スウェーデン,3302", _
"31,オーストリア,3027", "32,ボリビア,2897", "33,ロシア,2732", _
"34,カンボジア,2270", "35,トルコ,2049", "36,アイルランド,1767", _
"37,フィンランド,1759", "38,チェコ,1750", "39,チリ,1580", _
"40,デンマーク,1509", "41,南アフリカ,1377", "42,コロンビア,1355", _
"43,ミャンマー,1330", "44,ハンガリー,1287", "45,ポーランド,1255", _
"46,ネパール,1095", "47,ノルウェー,1065", "48,エジプト,1019", _
"49,スリランカ,1013", "50,イスラエル及びガザ地区等,997")
ThisWorkbook.Activate
Cells.Select
Selection.Clear
Selection.ColumnWidth = 15
Selection.RowHeight = 20
Selection.Font.Name = "MS ゴシック"
Selection.Font.Size = 10
'折り返して全体を表示する
Selection.WrapText = True
Range("A1").Select
Cells.Select
Selection.Clear
Selection.ColumnWidth = 15
Selection.RowHeight = 20
Selection.Font.Name = "MS ゴシック"
Selection.Font.Size = 10
'折り返して全体を表示する
Selection.WrapText = True
Range("A1").Select
'//A1セルよりデータをシートに展開
Dim i As Integer
Dim wkbuf As Variant
Dim i As Integer
Dim wkbuf As Variant
'//表のタイトルを出力
Cells(1, 1) = "国(地域)別在留邦人数上位50位(平成26年10月1日現在)"
Range("A1:B2").WrapText = False
For i = 0 To UBound(ar)
wkbuf = Split(ar(i), ",")
'不正なデータであれば次レコードへ
If UBound(wkbuf) < 2 Then GoTo nextrec
Cells(1, 1) = "国(地域)別在留邦人数上位50位(平成26年10月1日現在)"
Range("A1:B2").WrapText = False
For i = 0 To UBound(ar)
wkbuf = Split(ar(i), ",")
'不正なデータであれば次レコードへ
If UBound(wkbuf) < 2 Then GoTo nextrec
'データを表示
'表はB3セルより出力する
Cells(i + 3, 2) = wkbuf(0)
Cells(i + 3, 3) = wkbuf(1)
Cells(i + 3, 4) = wkbuf(2)
'表はB3セルより出力する
Cells(i + 3, 2) = wkbuf(0)
Cells(i + 3, 3) = wkbuf(1)
Cells(i + 3, 4) = wkbuf(2)
nextrec:
Next
Next
'罫線を引く
Range("B3:D" & CStr(UBound(ar) + 3)).Borders.LineStyle = xlLineStyleNone
Range("B3:D" & CStr(UBound(ar) + 3)).Borders.LineStyle = xlContinuous
Range("B3:D" & CStr(UBound(ar) + 3)).Borders.LineStyle = xlLineStyleNone
Range("B3:D" & CStr(UBound(ar) + 3)).Borders.LineStyle = xlContinuous
End Sub
よろしければポチッと押してください