VBA開発をする時、基本的で簡単なコードであれば覚えているのですが、たいていググるか昔のファイルを開いてコピペしちゃってます。
それで十分だとは思うのですが、その都度サイトやファイルを開くのがめんどくさいので、この記事にまとめておくことにしました。
内容 | リンク |
---|---|
月ごとの日付を算出 | Excelでカレンダーを自動作成するVBAマクロ |
最終行・最終列の取得 | Excel VBAでシフト表自動作成ツール |
シートの複製 | Excel VBAでシフト表自動作成ツール |
配列の宣言・格納 | Excel VBAでシフト表自動作成ツール |
Randomizeで配列内のデータをシャッフル | Excel VBAでシフト表自動作成ツール |
罫線の設定 | Excel VBAでシフト表自動作成ツール |
IEを使い情報の取得と入力 | Excel VBAとIEでウェブページの情報を取得する |
テーブルへ行追加 | 【Excel VBA】週次集計と月間集計を作成する仕入・売上表 |
印刷範囲の設定 | 【Excel VBA】週次集計と月間集計を作成する仕入・売上表 |
フィルタをかける | 【Excel VBA】週次集計と月間集計を作成する仕入・売上表 |
新規ブックを開く | 【Excel VBA】週次集計と月間集計を作成する仕入・売上表 |
セル範囲をコピペ | 【Excel VBA】週次集計と月間集計を作成する仕入・売上表 |
シートを削除 | 【Excel VBA】週次集計と月間集計を作成する仕入・売上表 |
PDFに出力 | 【Excel VBA】週次集計と月間集計を作成する仕入・売上表 |
ディレクトリ内のブックを順番に開いて処理
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つにまとめる時に使えます。
CSVファイルを開く
ブックとして開く
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
Exit Sub
End If
End If
Line Inputで読み込む
Dim openFileName As String
Dim strBuf As String
Dim strArray() As String
If Dir(ThisWorkbook.Path & "\sample.csv") <> "" Then
openFileName = ThisWorkbook.Path & "\sample.csv"
Else
openFileName = Application.GetOpenFilename("CSV(カンマ区切り),*.csv")
If openFileName = "False" Then
Exit Sub
End If
End If
Open openFileName For Input As #1
Do Until EOF(1)
Line Input #1, strBuf
If strBuf <> "" Then
strArray = Split(strBuf, ",")
MsgBox Replace(strArray(0), """", "")
End If
Loop
Close #1
読み込んだCSVファイルを#1として扱い、1行ずつ処理していきます。
Split関数を使ってカンマで分割し配列に格納します。配列のインデックスは0番から始まるので注意するのと、データはダブルクォーテーションで囲まれているのでReplace関数で取り除きます。
Line Input(値にカンマが含まれている場合)
Sub sample()
Dim openFileName As String
Dim strBuf As String
Dim strArray() As String
If Dir(ThisWorkbook.Path & "\sample.csv") <> "" Then
openFileName = ThisWorkbook.Path & "\sample.csv"
Else
openFileName = Application.GetOpenFilename("CSV(カンマ区切り),*.csv")
If openFileName = "False" Then
Exit Sub
End If
End If
Open openFileName For Input As #1
Do Until EOF(1)
Line Input #1, strBuf
If strBuf <> "" Then
strArray = Split(csvToTsv(strBuf), vbTab)
MsgBox Replace(strArray(0), """", "")
End If
Loop
Close #1
End Sub
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/
こちらの記事を参考にしました。
参考にした記事ではカンマをコロンに置き換えているのですが、コロンが含まれている場合のことを考えるとタブ記号に置換してTSVにしてしまうのがよいのではないかと思い少しアレンジしています。
CSVの文字コードがUTF-8の場合
Dim openFileName As String
Dim strBuf As String
Dim strLine() As String
Dim strArray() As String
If Dir(ThisWorkbook.Path & "\sample.csv") <> "" Then
openFileName = ThisWorkbook.Path & "\sample.csv"
Else
openFileName = Application.GetOpenFilename("CSV(カンマ区切り),*.csv")
If openFileName = "False" Then
Exit Sub
End If
End If
Set adoSt = CreateObject("ADODB.Stream")
With adoSt
.Charset = "UTF-8"
.Open
.LoadFromFile openFileName
strBuf = .ReadText
.Close
End With
strLine = Split(strBuf, vbCrLf)
For i = 1 To UBound(strLine)
If strLine(i) <> "" Then
strArray = Split(strLine(i), ",")
MsgBox (Replace(strLine(0), """", ""))
End If
Next i
ExcelはUTF-8に対応していないので、ADODB.Streamというオブジェクトに入れて対応します。
https://tonari-it.com/vba-csv-utf8/
こちらの記事を参考にしました。
このADODB.Streamを使うにはVBEのツール→参照設定から、Microsoft ActiveX Data Objects ○.○ Libraryにチェックを入れる必要があります。たぶんMacは対応していません。
最後のFor文は1からスタートしていますが、ヘッダー行を飛ばすためであって配列は0始まりです。
UTF-8のTSVファイルを開く
Dim openFileName As String
If Dir(ThisWorkbook.Path & "\sample.csv") <> "" Then
openFileName = ThisWorkbook.Path & "\sample.txt"
Else
openFileName = Application.GetOpenFilename()
End If
If openFileName <> "False" Then
Call Workbooks.OpenText(openFileName, Origin:=65001, Tab:=True)
Else
Exit Sub
End If
TSVファイルはLine Inputで開けるのですが、UTF-8の場合はそのまま開くと文字化けしてしまいます。
TSVファイルをExcelブックとして開きます。文字コードによってOpenTextの引数を変えます。
あとはブックとしていつも通り処理すればOK。
【参考記事】https://www.tipsfound.com/vba/18015
名前を付けて保存
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」が入力されます。
テキストファイルに出力
txtFileName = ThisWorkbook.Path & "\sample.txt"
Open txtFileName For Output As #1
Print #1, "sample"
Print #1, "test"
Print #1, ThisWorkbook.Path
Close #1
指定したファイルがなければ作成します。
ワークシートを探す
Dim ws As Worksheet
Dim sheetFlg As Boolean
For Each ws In Worksheets
If ws.Name = "サンプル" Then
sheetFlg = True
End If
Next
指定の名前がついたシートの存在を判定する。
ソート
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 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
既にリストが存在していれば削除してから、新たにリストを作成する。
シートを保護・解除する
/* 解除 */
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の引き数を変えることで日数や年・月・日・時・分・秒までいける。
特定の文字以下の文字列を取り出す
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
マクロ入りのシートをコピー、マクロ実行ボタンの参照先を変更
For i = 1 To ActiveSheet.DrawingObjects.Count
ActiveSheet.DrawingObjects(i).Select
namae = Selection.OnAction
If InStr(namae, "!") > 0 Then
namae = "'" & ActiveWorkbook.Name & "'!" & Mid(namae, InStr(namae, "!") + 1, Len(namae))
ActiveSheet.DrawingObjects(i).OnAction = namae
End If
Next
マクロ入りのシートをコピーした際、ボタンに登録されたマクロの参照先をコピー先にする処理です。
フォームを使用する

マクロの中でフォームを表示して値を取得します。
シートの一覧を表示して選択したシートをアクティブにし、ドロップダウンリストから年月を選択して変数に格納するというサンプルです。
標準モジュール
Sub formshow()
On Error GoTo Err_frmShow
Dim i As Integer
For i = 1 To Worksheets.Count
If Worksheets(i).Name <> "サンプル" Then 'シート名が「サンプル」ならば表示しない
UserForm1.ListBox1.AddItem (Worksheets(i).Name)
End If
Next i
UserForm1.Show
Err_frmShow:
Exit Sub
End Sub
Sub サンプル()
Dim setYear As Integer
Dim setMonth As Integer
'フォームを表示
Call formshow
If ActiveSheet.Name = csvSheetName Then
Exit Sub
Else
setYear = UserForm1.ComboBox1.Value
setMonth = UserForm1.ComboBox2.Value
Unload UserForm1
End If
End Sub
フォーム
Private Sub CommandButton1_Click()
UserForm1.Hide
End Sub
Private Sub CommandButton2_Click()
Worksheets("サンプル").Activate
Unload Me
End Sub
Private Sub ListBox1_Click()
Index = ListBox1.ListIndex 'ワークシートリストの選択された位置
Buf = ListBox1.List(Index) 'ワークシート名を取得
Worksheets(Buf).Activate
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
'年のコンボボックス 去年、今年、来年
For i = Year(Date) - 1 To Year(Date) + 1
ComboBox1.AddItem i
Next
'初期値は現在の年
Select Case Month(Date)
Case 12
ComboBox1.Value = Year(Date) + 1
Case Else
ComboBox1.Value = Year(Date)
End Select
'月のコンボボックス 12ヶ月
For i = 1 To 12
ComboBox2.AddItem i
Next
'初期値は現在の月
ComboBox2.Value = Month(Date)
End Sub
コメント