この記事では、私がこれまでVBAを使用してきた中で「これは使える」と思ったコードを抜粋したものです
ファイル保存
エクセルシートのCSV出力
出力したいシートをコピーして、新しいファイルを作成し、ファイル名を指定して保存します
ThisWorkbook.Worksheets(“出力”).Copy
ActiveWorkbook.SaveAs “D:\TEST.csv”, FileFormat:=xlCSV
ActiveWorkbook.Close
文字列操作
分割
文字列の分割にはSplitを使用します
Variant型で設定した変数をSplitで分割し、変数(0)、変数(1)、変数(2)で受け取ります
例えば、シートのB1セルに「600-1」の文字列があるとします
こちらの文字列を「-」で分割し、それぞれをメッセージで表示するとします
その場合は、次のコードで実現できます
Dim mySTRING As Variant
Dim myWORD As Variant
Dim myYEAR As String
Dim myMONTH As String
mySTRING = Worksheets(“Sheet1”).Range(“B2”).Value
myWORD = Split(mySTRING, “-“)
myYEAR = myWORD(0)
MsgBox myYEAR
myMONTH = myWORD(1)
MsgBox myMONTH
まず、myWORD(0)で600を取りだします
次にmyWORD(1)で1を取り出します
固定文字が含まれているかを判断する
Instr関数を使用し、０以上なら含まれていると判断します
Dim myCountWaritsuke As Long ‘固定の文字が含まれいる位置
myCountWaritsuke = InStr(“myTEST1”, “TEST”)
MsgBox myCountWaritsuke
上のコードの場合は、myTESTの文字列の3文字目にTESTの文字列が含まれているので3とメッセ―ジが出力されます
文字列への変換
数値の文字列への変換にはStr関数を使用します
Str関数を交えた下のコードを実行してみます
Dim myVal As Long
myVal = 1
Worksheets(“Sheet1”).Range(“B2”).Value = “A-” & Str(myVal)
するとB2セルに以下のような文字列が入力されます
ここで1点問題があります
半角の空白がStr関数で変換した文字列に入ってしまっています
こちらが気になる場合はCstr関数を使用します
Worksheets(“Sheet1”).Range(“B2”).Value = “A-” & CStr(myVal)
これで空白は入らないようになります
数値への変換
こちらはVal関数を使用します
Dim myVal As String
myVal = “1”
Worksheets(“Sheet1”).Range(“B2”).Value = Val(myVal) + 1
上のコードを実行すると「２」がB2セルに入力されます
数値かどうかの判定
対象の’文字’が数値かどうかの判定は「IsNumeric」を使用します
試しに次のコードを実行してみます
MsgBox IsNumeric(123)
そうすると次の画像のようにTRUEが出力されます
次に以下のコードを実行してみます
MsgBox IsNumeric(“TEST”)
この場合はFALSEが出力されます
注意して頂きたいのは、次の場合はTRUEが出力されます
MsgBox IsNumeric(“１２３”)
これはあくまで１２３が数値文字だからです
メール関連
表をメールの本文に入れる
シート内の表の内容をHTMにするのがポイントです
＊＊＊HTMLの作成＊＊＊
With Worksheets(“MAIL”)
myLast = .Cells(Rows.Count, 2).End(xlUp).Row
For i = 6 To myLast
myProduct = .Cells(i, 2).Value
myQuantity = .Cells(i, 3).Value
myPrice = .Cells(i, 4).ValuemyData = myData & “” & “” & myProduct & “” & myQuantity & “” & myPrice & “”
Next
＊＊＊＊＊＊＊＊＊＊＊＊
そして、作成したHTMLをメールの本文に入れます（メールは送付せず、表示のみにしています）
*正確には事前に見出しを作成しておき、中身を変数で付け加える形です
‘メールの作成
'OutlookのMailitemオブジェクトを取得する
Dim objOutlook As New Outlook.Application
Dim objMailitem As Outlook.MailItem
Set objMailitem = objOutlook.CreateItem(olMailItem)
'メールの各種設定をする
With objMailitem
.To = "analytic@analytic-vba.com" '宛先
'.CC = myCc 'CC
.Subject = "TEST"
'.SentOnBehalfOfName = mySenderAddress
.HTMLBody = "<font face=""遊ゴシック""><font size=""2.5"">" & _
"<body><table border=1><tr>" & "<th>Product</th><th>Quantity</th><th>Price</th>" & "
</tr>" & _
myData & "</font></table></body>"
.Display '新規メール画面を表示
End With 'objMailitemこれでエクセルシート内の表がメールの本文に入ります
ファイルを添付して送付
.Attachments.Add+ファイル名の一文を上記のコードに追加します
Dim objMailitem As Outlook.MailItem
Set objMailitem = objOutlook.CreateItem(olMailItem)
'メールの各種設定をする
With objMailitem
.To = "analytic@vba.com" '宛先
（省略）
.Attachments.Add "C:\Users\＊＊＊\Downloads\download.csv"
.Display '新規メール画面を表示
End With 'objMailitemユーザーフォーム
ユーザーフォームについてはこちらの記事もご参考にしてください
処理中表示
マクロの処理に時間がかかる場合は「処理中」の表示をしておきたい場合があります
こちらの表示にはユーザーフォームを使いたいところですが、ユーザーフォームを表示すると後続処理が止まってしまいます
ですので、以下のように「vbModeless」「Repaint」を使用します
Sub test()
UserForm1.Show vbModeless
UserForm1.Repaint
MsgBox “TEST”
Unload UserForm1
End Sub
上記のコードであれば、ユーザーフォームを表示しながらメッセージボックスも表示されます
ファイルの扱い
ファイルパスを指定して開く
Openメソッドを使用します
Dim myFileNameBefore As String
myFileNameBefore = “D:\Copy元.xlsx”
Workbooks.Open myFileNameBefore
ファイルを別名保存（コピー）する
SaveAsメソッドを使用します
Dim myFileNameBefore As String
Dim myFileNameAfter As String
myFileNameBefore = “D:\Copy元.xlsx”
myFileNameAfter = “D:\Copy先.xlsx”
Workbooks.Open myFileNameBefore
ActiveWorkbook.SaveAs Filename:=myFileNameAfter
ActiveSheet.Range(“B2”).Value = “TEST”
重複削除
重複削除を行うにはRemoveDuplicatesを使用します
複数列をキーに重複削除を行う際には、第二引数のArrayの中に列番号を複数指定します
例えば、次の表を「A」「B」の2列で重複削除を行うとします
この場合は、次のようなコードを書きます
Dim myLast As Long ‘最終行
myLast = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Range(“A1:C” & myLast).RemoveDuplicates (Array(1, 2))
これで次のように削除されます
シート操作
全ページ操作
ファイル内の全シートを一律に操作するには「For Each ~ in ~ Next」構文を使用します
次の画像では、各シートのA1セルに値が入っています
そして、シートB以外はA1セルの値を読んでメッセージを表示するようにします
コードは一度、シート変数：wsTESTを宣言した後に次のように書きます
For Each wsTEST In Worksheets
If wsTEST.Name <> “B” Then
wsTEST.Activate
MsgBox Range(“A1”).Value
End If
Next
ちなみにSheet変数.nameでシート名が取得できます
印刷設定
印刷範囲設定
Dim myLast As Long
‘最終行取得
myLast = Worksheets(“Sheet4”).Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets(“Sheet4”).PageSetup
‘印刷範囲設定
.PrintArea = “A1:M” & myLast
End with
全列を全て印刷
Application.PrintCommunication = False
With Worksheets(“Sheet4”).PageSetup
‘*全ての列を印刷
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Application.PrintCommunication = True
改ページプレビューに設定
ActiveWindow.View = xlPageBreakPreview
