VBA - 変換.tokyo | henkan.tokyo

【Excel VBA】リストの差分を抽出する(重複しない一意の値を表示する)


■【Excel VBA】リストの差分を抽出する(重複しない一意の値を表示する)

Excelシート上の2つのリストを比較し、「相互の差分を抽出したい!」な〜んていうことはありませんか?
この程度でしたら、本来はVBAを使わなくても出来ますが…

今回はこちらのWebサイト「2つの列の差分を求める(重複しない一意の値を求める)」を参考に作成してみました。
https://hamachan.info/win8/excel/sabun.html

ポイントは、重複値に対する条件付き書式(一意)である「.DupeUnique = xlUnique」です。

VBA_Difference_comparison.png


■サンプルコード

Sub Difference_comparison()
Range("A2:B200").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlUnique

'フォントを濃い赤に、セルの背景は薄い赤に設定
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub


■サンプルVBAダウンロード


■VBA開発に参考となる書籍
[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

入門者のExcel VBA 初めての人にベストな学び方 (ブルーバックス) [ 立山秀利 ]
価格:1058円(税込、送料無料) (2018/10/1時点)

楽天で購入

[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

たった1日で即戦力になるExcelの教科書 [ 吉田拳 ]
価格:1922円(税込、送料無料) (2018/10/1時点)

楽天で購入


【Excel VBA】Excel VBAからCSVファイルを読み込む

 
■【Excel VBA】Excel VBAからCSVファイルを読み込む

Excel VBAからCSVファイルを取り込む機会は多いと思いますが、CSVファイルの開き方や読み込み方にもいろいろあり、また読み込む速度も大きく異なる場合があります。

今回は、(1)定番の読み込み方、(2)改行された値を含むCSVの読み込み方、の2つをご紹介します♪

まずは(1)定番の読み込み方から。こちらは、

Webサイト「Excel VBAを使ったCSVファイル読み込み時の高速化、タブ区切り対応、ダブルクォーテーション削除のコツ」
http://www.atmarkit.co.jp/ait/articles/1706/16/news032.html

を参考に作成しました。


【サンプルコード@ 定番】

Sub CSVファイルの読み込み()
Dim fso As New Scripting.FileSystemObject
Dim csvFile As Object
Dim csvData As String
Dim splitcsvData As Variant
Dim i As Integer
Dim j As Integer

'OpenTextFileメソッドでCSVデータを、読み込み専用で開く
Set csvFile = fso.OpenTextFile("C:\test\test.csv", 1)
i = 1

'変数iを1で初期化しておき、AtEndOfStreamプロパティを使うことでファイルの最後の行に達するまで、処理を繰り返す
Do While csvFile.AtEndOfStream = False
'ReadLineメソッドで読み込んだCSVファイルの1行を読み込む
csvData = csvFile.ReadLine

'Split関数でカンマ(,)で区切られた各文字列を(1次元)配列として返し、変数splitcsvDataに格納する
splitcsvData = Split(csvData, ",")

'UBound関数を使い配列の要素の数を調べ、変数jに格納する。+1しているのは配列の添え字が0から開始されるため
j = UBound(splitcsvData) + 1

'Sheet2のi行目の1列目からi行目のj列目までの範囲に、読み込んだCSVデータを表示する
Sheet2.Range(Sheet2.Cells(i, 1), Sheet2.Cells(i, j)).Value = splitcsvData
i = i + 1
Loop

csvFile.Close
Set csvFile = Nothing
Set fso = Nothing

End Sub


続いて、(2)改行された値を含むCSVを読み込む場合です。

CSVファイルを読み込むVBAを簡単に作成するには【サンプルコード@ 定番】のような形を取ることが多いですが、この作り方の場合、動きとしてはテキストファイルを1行ずつ読み込んでいくようなイメージになります。
この場合、例えば値の中に改行コードを含むようなCSV(ex. Excelのセルの中でAlt+Enterキーで改行したような値を含む etc.)を読み込んでしまうと...ご想像の通り、1レコードの途中で改行されてしまい、正しくCSVファイルを読み込めなくなります。

そんなCSVを読み込む時には...
非常にシンプルな考え方ですが、CSVファイルを開いて、その内容をExcelシートにコピーする、という方法もあります。
こちらは、

Webサイト「マクロ(Excel VBA)で CSV ファイルを開いてシートの中に取り込む方法」
https://my-tax-nology.com/import-csv-data-to-excel-by-using-excel-vba

を参考に作成しました。

VBA_Read_csv.png


【サンプルコードA 改行された値を含むCSVの読み込み】

Sub Csv_Import()

Dim A_Sheet 'Excelファイルのシート名を入れ込む変数'
Dim Csv_Import_File 'Excelファイルに取り込むCSVファイルの名前を入れ込む変数'

'現在アクティブなシート名を変数 A_Sheet に入れ込む
A_Sheet = ActiveSheet.Name
'CSVファイルを選択する
Csv_Import_File = Application.GetOpenFilename("CSVファイル,*.csv")
If Csv_Import_File = "False" Then Exit Sub 'キャンセルなら終了

'「CSVデータ取込み」シートのセル「A1〜ZZ100000」をクリアする
ThisWorkbook.Sheets("CSVデータ取込み").Range("A1:ZZ100000").ClearContents

With Workbooks.Open(Csv_Import_File)
'全てのデータをこのブックの「CSVデータ取込み」シートにコピー
.Sheets(1).Cells.Copy ThisWorkbook.Sheets("CSVデータ取込み").Range("A1")
.Close 'CSVファイルを閉じる'
End With

'A_Sheet という名前のシートをアクティブにする'
Worksheets(A_Sheet).Activate

End Sub


■サンプルVBAダウンロード
こちらから


■VBA開発に参考となる図書

[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

入門者のExcel VBA 初めての人にベストな学び方 (ブルーバックス) [ 立山秀利 ]
価格:1058円(税込、送料無料) (2018/10/1時点)

楽天で購入

[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

たった1日で即戦力になるExcelの教科書 [ 吉田拳 ]
価格:1922円(税込、送料無料) (2018/10/1時点)

楽天で購入


【Excel VBA】Excel VBAからWMIを使って各ドライブの空き容量を取得する

 
■【Excel VBA】Excel VBAからWMIを使って各ドライブの空き容量を取得する

Webサイト「Excel VBA から WMI を使ってみよう - WMI Step」を参考に作成しました。
http://www.wmifun.net/step/vba_01.html


皆さんは「WMI」をご存知でしょうか?
WMIとは「Windows Management Instrumentation」の略で、Windows管理技術の中核を担っています。
WMIは、ローカル コンピュータとリモート コンピュータの両方の管理に使用できます。
WMIは、プログラミング言語やスクリプト言語で日常的な管理タスクを実行するための一貫したアプローチを提供します。

たとえば、次のようなことが実行可能です。
・リモート コンピュータ上のプロセスを起動
・特定の日時にプロセスを実行するようにスケジュールを設定
・コンピュータをリモートで再起動
・ローカル コンピュータまたはリモート コンピュータにインストールされているアプリケーションのリストを取得
・ローカル コンピュータまたはリモート コンピュータ上の Windows イベント ログを照会

WMIは、VBAを使用することができる各Officeアプリケーションから使用することが出来ます。
(他に、VBやVBS、PowerShellやBatからも実行可能です)
このサンプルでは、各ドライブごとに空き容量と全容量(単位:バイト)をGBに変換、小数点第2位で四捨五入した値を表示しています。
※参照設定から「Microsoft WMI Scripting V1.2 Library」を追加してから実行してください。

WMI_VBA.png



■サンプルコード

Sub GetWMItoExcel()

Dim oDiskSet As SWbemObjectSet
Dim oDisk As SWbemObject
Dim oLocator As SWbemLocator
Dim oService As SWbemServices
Dim i As Long
Set oLocator = New WbemScripting.SWbemLocator
Set oService = oLocator.ConnectServer
Set oDiskSet = oService.ExecQuery _
("Select * From Win32_LogicalDisk Where DriveType=3")
Worksheets("Sheet1").Cells(1, 1).Value = "各ドライブの空き容量は、"
i = 1
'各ドライブごとに空き容量と全容量(単位:バイト)をGBに変換し、小数点第2位で四捨五入
For Each oDisk In oDiskSet
Worksheets("Sheet1").Cells(i + 1, 1).Value = oDisk.Name & " " & Round(oDisk.FreeSpace / 1024 / 1024 / 1024, 1) & "GB / " & Round(oDisk.Size / 1024 / 1024 / 1024, 1) & "GB"
i = i + 1
Next
Set oDiskSet = Nothing
Set oDisk = Nothing
Set oLocator = Nothing
Set oService = Nothing

End Sub

WMI_xlsx.png


■サンプルVBAダウンロード
こちらから


■VBA開発・WMI利用に参考となる図書

[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

入門者のExcel VBA 初めての人にベストな学び方 (ブルーバックス) [ 立山秀利 ]
価格:1058円(税込、送料無料) (2018/10/1時点)

楽天で購入


[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

たった1日で即戦力になるExcelの教科書 [ 吉田拳 ]
価格:1922円(税込、送料無料) (2018/10/1時点)

楽天で購入


[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

ネットワーク管理に使うWMI PowerShellによるWindowsマシン管理 [ 嶋貫健司 ]
価格:6480円(税込、送料無料) (2018/10/1時点)

楽天で購入

【Excel VBA】「Yahoo路線情報」の乗り換え案内を使って、複数分の移動時間・運賃を一括検索する

 
■【Excel VBA】「Yahoo路線情報」の乗り換え案内から、複数分の移動時間・運賃を一括検索する

例えばオフィスを移転するような場合、人事の担当者は、スタッフの交通費がどれくらい増減するのか等を気にすると思います。
そこで「Yahoo路線情報」の乗り換え案内の情報を自動的に取得、複数名分の移動時間・運賃を一括で検索し、リスト表示するというExcel VBAをご紹介致します。

今回、こちらのWebサイト「VBA(マクロ)で仕事を楽しく効率化」の情報を参考にさせていただきました。
http://officevba.info/norikaevba/



■VBAの動作

プログラムの基本的な流れは以下の通りです。
@InternetExplorerを開く
A「Yahoo路線情報」のページ(http://transit.yahoo.co.jp/)に移動する
B出発地・目的地・時間・その他新幹線を使用するか、特急を使用するかなどの条件を入力(〇印を付ける)する
C「Yahoo乗換案内で検索」ボタンをクリックする
D表示されたページから必要な情報を収集し、Excelシートに転記する
E上記A〜Dを繰り返す
FInternetExplorerを終了する



■サンプルコード

Option Explicit
Dim colSh As Object
Dim win As Object
Dim strTemp As String
Dim IE As InternetExplorer
Dim objIE(5) As InternetExplorer
Dim objIE2 As InternetExplorer
Dim txtInput(16) As HTMLInputElement
Dim txtInput2(20) As HTMLSelectElement
Dim button(10) As HTMLInputElement
Dim Form
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub 集計()
Dim x As Long
IE立ち上げ
x = 4
Do Until x > Cells(60000, 3).End(xlUp).Row
乗り換え案内検索 (x)
乗り換え案内結果集計 (x)
IE繰り返し
x = x + 1
Loop
IE終了
End Sub

Private Sub IE立ち上げ()
'@InternetExplorerを開く
Set IE = CreateObject("InternetExplorer.application")
IE.Visible = True
'AYahoo乗り換え検索のページ("http://transit.yahoo.co.jp/")に移動
IE.navigate ("http://transit.yahoo.co.jp/")
Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 1000
End Sub

Private Sub 乗り換え案内検索(i As Long)
Set colSh = CreateObject("Shell.Application")
For Each win In colSh.Windows
If TypeName(win.document) = "HTMLDocument" Then
If InStr(win.document.Title, "乗換案内") > 0 Then
Set objIE(0) = win
Exit For
End If
End If
Next
'B出発地・目的地・時間・その他新幹線を使用するか、特急を使用するかなどの条件入力
'B-1 出発地の入力
Set txtInput(1) = objIE(0).document.getElementById("sfrom")
txtInput(1).Value = Cells(i, 3).Value
'B-2 到着地の入力
Set txtInput(2) = objIE(0).document.getElementById("sto")
txtInput(2).Value = Cells(i, 4).Value
'B-3 新幹線を利用するか
Set txtInput(3) = objIE(0).document.getElementById("sexp")
If Cells(i, 8).Value = "○" Then
txtInput(3).Checked = True
Else
txtInput(3).Checked = False
End If
'B-4 有料特急を利用するか
Set txtInput(4) = objIE(0).document.getElementById("exp")
If Cells(i, 9).Value = "○" Then
txtInput(4).Checked = True
Else
txtInput(4).Checked = False
End If
'B-5 出発時間での検索
Set txtInput(5) = objIE(0).document.getElementById("tsDep")
If Cells(i, 5).Value = "出発" Then
txtInput(5).Checked = True
End If
'B-6 到着時間での検索
Set txtInput(6) = objIE(0).document.getElementById("tsArr")
If Cells(i, 5).Value = "到着" Then
txtInput(6).Checked = True
End If
'B-7 日時の入力
Set txtInput2(0) = objIE(0).document.getElementById("y")
txtInput2(0).Value = Year(Cells(i, 6))
Set txtInput2(1) = objIE(0).document.getElementById("m")
txtInput2(1).Value = Format(Month(Cells(i, 6)), "00")
Set txtInput2(2) = objIE(0).document.getElementById("d")
txtInput2(2).Value = Format(Day(Cells(i, 6)), "00")
Set txtInput2(3) = objIE(0).document.getElementById("hh")
txtInput2(3).Value = Format(Hour(Cells(i, 7)), "00")
Set txtInput2(4) = objIE(0).document.getElementById("mm")
txtInput2(4).Value = Format(Minute(Cells(i, 7)), "00")
'B-8 検索結果表示順の選択
Set txtInput2(5) = objIE(0).document.getElementsByName("s")(0)
If Cells(i, 10).Value = "到着が早い順" Then
txtInput2(5).Value = "0"
ElseIf Cells(i, 10).Value = "乗り換え回数順" Then
txtInput2(5).Value = "2"
ElseIf Cells(i, 10).Value = "料金が安い順" Then
txtInput2(5).Value = "1"
End If
'C検索ボタンをクリック
Set Form = objIE(0).document.getElementById("searchModuleSubmit")
Form.Click
Sleep 1000
Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 1000
End Sub

Sub 乗り換え案内結果集計(i As Long)
Set colSh = CreateObject("Shell.Application")
For Each win In colSh.Windows
If TypeName(win.document) = "HTMLDocument" Then
If InStr(win.document.Title, "乗換案内") > 0 Then
Set objIE(0) = win
Exit For
End If
End If
Next
'D表示されたページから必要な情報を収集
Set txtInput(7) = objIE(0).document.getElementsByClassName("small")(0)
Cells(i, 11).Value = txtInput(7).innerText
Cells(i, 11).Value = Replace(Replace(Cells(i, 11), "(", ""), ")", "")
Set txtInput(8) = objIE(0).document.getElementsByClassName("small")(1)
Cells(i, 13).Value = txtInput(8).innerText
Cells(i, 13).Value = Replace(Replace(Cells(i, 13), "(", ""), ")", "")
Set txtInput(9) = objIE(0).document.getElementsByClassName("small")(2)
Cells(i, 15).Value = txtInput(9).innerText
Cells(i, 15).Value = Replace(Replace(Cells(i, 15), "(", ""), ")", "")
Set txtInput(10) = objIE(0).document.getElementsByClassName("fare")(0)
Cells(i, 12).Value = txtInput(10).innerText
Set txtInput(11) = objIE(0).document.getElementsByClassName("fare")(1)
Cells(i, 14).Value = txtInput(11).innerText
Set txtInput(12) = objIE(0).document.getElementsByClassName("fare")(2)
Cells(i, 16).Value = txtInput(12).innerText
End Sub

Private Sub IE繰り返し()
Set colSh = CreateObject("Shell.Application")
For Each win In colSh.Windows
If TypeName(win.document) = "HTMLDocument" Then
strTemp = win.document.body.innerText
If InStr(strTemp, "乗換案内") > 0 Then
Set objIE(0) = win
Exit For
End If
End If
Next
'E-1 Yahoo乗り換え検索のページ("http://transit.yahoo.co.jp/")に移動
objIE(0).navigate ("http://transit.yahoo.co.jp/")
Sleep 1000
Do While objIE(0).Busy Or objIE(0).readyState < READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 1000
End Sub

Private Sub IE終了()
Set colSh = CreateObject("Shell.Application")
For Each win In colSh.Windows
If TypeName(win.document) = "HTMLDocument" Then
strTemp = win.document.body.innerText
If InStr(strTemp, "乗換案内") > 0 Then
Set objIE(0) = win
Exit For
End If
End If
Next
'FInternetExplorerを終了
objIE(0).Quit
End Sub


■サンプルVBAダウンロード
こちらから

■VBAからIEを操作するのに参考となる図書




【Excel VBA】マウス移動時に処理を行う

  
【Excel】マウス移動時に処理を行う

Excel VBA

・マウス移動時に処理を行う

コマンドボタンの上をマウスが移動すると、MouseMoveイベントが発生します。

このイベントのイベントプロシージャの引数から、イベントが発生したときの、コントロール内でのマウスのX座標・Y座標、押されていたマウスボタン、および、ShiftキーやAltキー、Ctrlキーが押されていたかどうかを取得することができます。

サンプルでは、コマンドボタンの上をマウスカーソルが移動したときに、Shiftキーが押されている場合にのみ、コマンドボタンを赤色に変えるようにしています。


VBAマウス移動MouseMove

■サンプルコード
Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

  If Shift = 1 Then

   CommandButton1.BackColor = RGB(255, 0, 0)

  End If

End Sub