VBA開発をする時、基本的で簡単なコードであれば覚えているのですが、たいていググるか昔のファイルを開いてコピペしちゃってます。
それで十分だとは思うのですが、その都度サイトやファイルを開くのがめんどくさいので、この記事にまとめておくことにしました。
ファイルの処理
新規ブックを作成
Workbooks.Add
ブックとして開く
Dim openFileName As String
If Dir(ThisWorkbook.Path & "\sample.csv") <> "" Then
Workbooks.Open ThisWorkbook.Path & "\sample.csv"
Else
openFileName = Application.GetOpenFilename("CSV(カンマ区切り),*.csv")
If openFileName <> "False" Then
Workbooks.Open openFileName
Else
MsgBox "キャンセルが押されました。" _
& vbCrLf & "作業を中止します。"
Exit Sub
End If
End If
ブックと同一パスに指定のファイルがあればそのまま開き、無ければポップアップして選択し開く。
ブックを閉じる
Application.EnableEvents = False
ActiveWorkbook.Close SaveChanges:=True
閉じる際に出る何かしらのポップアップを拒否し、保存する場合のコード。
ディレクトリ内のブックを順番に開いて処理
Dim path, fso, file, files
Dim wb As Workbook
path = ThisWorkbook.path & "\サンプルフォルダ"
Set fso = CreateObject("Scripting.FileSystemObject")
Set files = fso.GetFolder(path).files
For Each file In files
Set wb = Workbooks.Open(file)
/* 各ブックに対する処理 */
Application.EnableEvents = False
ActiveWorkbook.Close SaveChanges:=True
Next file
VBA:フォルダ内のファイルを順次処理を参考にしました。
複数のExcelブックを1つにまとめる時に使えます。
名前を付けて保存
Dim saveFile As String
Dim saveName As String
saveName = "サンプル"
saveFile = Application.GetSaveAsFilename(saveName, FileFilter:="Excelファイル,*.xlsx,すべてのファイル,*.*")
ActiveWorkbook.SaveAs Filename:=saveFile, FileFormat:=xlNormal
'CSVの場合
saveFile = Application.GetSaveAsFilename(sheetName, FileFilter:="CSV(カンマ区切り),*.csv")
ActiveWorkbook.SaveAs Filename:=saveFile, FileFormat:=xlCSV
ユーザが保存先や名前を自由に決められます。デフォルトでは「サンプル.xlsx」が入力されます。
PDFとして出力
Dim fileName As String
Dim sheetName As String
sheetName = ActiveSheet.Name
If Application.OperatingSystem Like "*Mac*" Then
' Mac 向けの処理
fileName = ThisWorkbook.Path & "/" & sheetName & ".pdf"
Else
' Windows 向けの処理
fileName = ThisWorkbook.Path & "\" & sheetName & ".pdf"
End If
With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName
Macではフォルダの区切りが\ではなく/になるので、ファイル名をつける際にOSで分岐させます。
テキストファイルに出力
txtFileName = ThisWorkbook.Path & "\sample.txt"
Open txtFileName For Output As #1
Print #1, "sample"
Print #1, "test"
Print #1, ThisWorkbook.Path
Close #1
指定したファイルがなければ作成します。
CSVやTSVを開いて配列に格納
Dim openFileName As String
Dim strBuf As Variant
Dim strArray As Variant
Dim setRow As Integer
openFileName = Application.GetOpenFilename("テキストファイル (*.txt),*.txt")
'CSVファイルの場合は "CSV(カンマ区切り),*.csv"
If openFileName <> "False" Then
Open openFileName For Input As #1
Else
MsgBox "キャンセルが押されました。" _
& vbCrLf & "作業を中止します。"
Exit Sub
End If
setRow = 1
Do Until EOF(1)
Line Input #1, strBuf
If strBuf <> "" Then
strArray = Split(strBuf, vbTab)
For i = 0 To UBound(strArray)
Cells(setRow, i+1).Value = strArray(i)
Next
setRow = setRow + 1
End If
Loop
Close #1
ワークシートを探す
Dim ws As Worksheet
Dim sheetFlg As Boolean
For Each ws In Worksheets
If ws.Name = "サンプル" Then
sheetFlg = True
End If
Next
指定の名前がついたシートの存在を判定する。
表の最終行を取得し空白行を削除
Dim rowStart As Integer
Dim rowEnd As Integer
Dim colStart As Integer
Dim colEnd As Integer
'空白セルがある場合はここから
ActiveWorkbook.Worksheets(1).Range("A2").Select
rowStart = Selection.Row
rowEnd = Cells.SpecialCells(xlCellTypeLastCell).Row
colStart = Selection.Column
colEnd = Cells.SpecialCells(xlCellTypeLastCell).Column
'空白セルがない場合はここから
ActiveWorkbook.Worksheets(1).Range("A2").Select
startRow = Selection.Row
rowEnd = Selection.End(xlDown).Row
startCol = Selection.Column
rowCol = Selection.End(xlToRight).Column
基本はCtrl + Shift + ↓、あるいはCtrl + Shift + →の操作をした際の最終行・列を取得。
途中で空白セルがある場合はうまく機能しないためSpecialCellsを使う。
ソート
Worksheets(1).Range(Cells(2, 1), Cells(100, 5)) _
.Sort Key1:=Worksheets(1).Cells(2, 2), order1:=xlAscending, _
Key2:=Worksheets(1).Cells(2, 3), order2:=xlDescending
ヘッダー行ではなくデータが始まる行を指定。
xlAscendingが昇順、xlDescendingが降順。
文字列を含んでいるかの分岐
Dim sample As String
Dim testFlg As Boolean
sampleFlg = False
If InStr(sample, "テスト") > 0 Then
testFlg = True
End If
文字列を含んでいた場合1を返す。含んでいない場合は>を=にすればよい。
指定文字列より左側を取得
sample = Left(sample, InStr(sample, " "))
InStr関数の応用。Right関数を使えば右側を取得できる。
コピペ
Worksheets(1).Range("A2", "F" & i).Copy
Worksheets(2).Range("A2").PasteSpecial Paste:=xlPasteValues
このような場合、コピペするブックやシートがアクティブになった気がする(うろ覚え)
変数に格納して代入する場合はアクティブなブックやシートは変わらない。
置換
Range("A2", "A" & i).
Replace What:="/", Replacement:="", LookAt:=xlPart
Dim sample As String
sample = Replace(sample, "/", "")
2パターンあり、上はセル範囲の置換、下は変数の置換で使いやすい。
リストを作成する
Dim listName As Name
Dim a As Integer
a = 100
For Each listName In ThisWorkbook.Names
If listName.Name = "サンプル" Then
Range("サンプル").Name.Delete
End If
Next
ActiveWorkbook.Names.Add _
Name:="サンプル", _
RefersTo:="=Sheet1!$A$2:$C$" & a
既にリストが存在していれば削除してから、新たにリストを作成する。
罫線を引く
Range("A2", "E50").Borders.LineStyle = xlContinuous
シートを保護・解除する
/* 解除 */
ActiveSheet.Unprotect
/* 保護 */
ActiveSheet.Protect
マクロ実行時のみ保護を解除する
ThisWorkbook.Worksheets("サンプル").Protect UserInterfaceOnly:=True
シートの枚数を数えて指定のシートをアクティブにする
Dim sheetCnt As Integer
sheetCnt = Worksheets.Count
For i = 1 To sheetCnt
If sheetName = Worksheets(i).name Then
Worksheets(i).Activate
Exit For
End If
Next
現時点の日付でマクロ実行ファイルと同じフォルダに保存
Dim thisPath As String
Dim todayDate As String
thisPath = ActiveWorkbook.Path
todayDate = Format(Now, "yyyymmdd")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=thisPath & todaysDate & ".xlsx"
Application.DisplayAlerts = True
日付の計算
Dim setDate As date
setDate = "2020/05/01"
setDate = DateAdd("d", 3, setDate)
MsgBox(setDate)
setDateに3日足す例。
DateAddの引き数を変えることで日数や年・月・日・時・分・秒までいける。
CSVをTSVに変換
strArray = Split(csvToTsv(tmp(i)), vbTab)
Function csvToTsv(ByRef str As String) As String
Dim strTemp As String
Dim quotCount As Long
Dim l As Long
For l = 1 To Len(str)
strTemp = Mid(str, l, 1)
If strTemp = """" Then
quotCount = quotCount + 1
ElseIf strTemp = "," Then
If quotCount Mod 2 = 0 Then
str = Left(str, l - 1) & vbTab & Right(str, Len(str) - l)
End If
End If
Next l
csvToTsv = str
End Function
参考:https://tonari-it.com/vba-csv-camma/
CSVのダブルクオーテーションを消す
str = Replace(str, """", "")
特定の文字以下の文字列を取り出す
str = Right(str, Len(str)) - InStr(str, "$"))
頭に”$”があるデータから、$より右側を取得。
CSVファイルを作成→書き込み→閉じる
myPath = ThisWorkbook.Path
fileName = myPath & "\" & "sample.csv"
Open fileName For Output As #1
Print #1, str
Close #1
コメント