現時点のシート数を確認するメッセージを出す
Sub sample()
MsgBox Sheets.Count
End Sub
セルに値を入力する基本
Sub sample2()
Range(“D20″) = 10000
Cells(23, 4) = “すごい改善”
End Sub
連続処理、繰り返し処理を行うForNext構文
Sub ForNext()
Dim i As Long
For i = 12 To 23
Cells(i, 3) = Cells(i, 1) / Cells(i, 2)
Next i
End Sub
データの最終行を自動判別するテクニック
Sub 最終行取得()
Dim i As Long
For i = 11 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(i, 3) = Cells(i, 1) / Cells(i, 2)
Next i
End Sub
VBA関数の使い方
Sub VBA関数()
Cells(8, 3) = Left(Cells(8, 2), 4)
Cells(11, 3) = Mid(Cells(11, 2), 5, 2)
Cells(14, 3) = Right(Cells(14, 2), 2)
Cells(17, 3) = Year(Cells(17, 2))
Cells(23, 3) = Date
End Sub
VLOOKUPなどそのままでは使えないワークシート関数の使い方
Sub Worksheet()
Dim i As Long
For i = 15 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(i, 4) = WorksheetFunction.VLookup(Cells(i, 3), Range(“J:L”), 2, 0)
Next i
End Sub
条件分岐を行うIfThen構文
Sub IFTHEN()
Application.ScreenUpdating = False
Dim i As Long
For i = 10 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(i, 3) >= 80 Then
Cells(i, 4) = “合”
Else
Cells(i, 4) = “不合格”
End If
Next i
End Sub
書式設定を通して「オブジェクト」、「プロパティ」とVBA基礎構文を理解する
Sub 書式設定()
Application.ScreenUpdating = False
With Sheets(“書式設定”)
.Range(“E5″).Font.Bold = True
.Range(“E7″).Interior.ColorIndex = 3
.Range(“E9″).Font.ColorIndex = 3
.Range(“E11″).Font.Size = 14
.Range(“E13″).Borders.LineStyle = xlContinuous
.Range(“E15″).NumberFormatLocal = “#,###,”
End With
End Sub
シートの追加や削除を通じて「メソッド」を理解する
Sub シート追加()
Worksheets.Add
ActiveSheet.Name = “すごい改善”
End Sub
Sub シート削除()
Application.DisplayAlerts = False
Sheets(“すごい改善”).Delete
End Sub
別のブックを開いて閉じる定番コード
Sub ブックを開く()
Application.ScreenUpdating = False
Dim filename As String
filename = Dir(ThisWorkbook.Path & “\請求書*”)
Workbooks.Open ThisWorkbook.Path & “\” & filename
ActiveWorkbook.Close
End Sub
面倒な大量のフォルダ作成を瞬殺する
Sub 支社別フォルダ()
Application.ScreenUpdating = False
Dim i As Long
For i = 3 To Cells(Rows.Count, “K”).End(xlUp).Row
MkDir ThisWorkbook.Path & “\支社別フォルダ\” & Cells(i, “K”)
Next i
End Sub
ForNext構文にIfThen構文を組み込む鉄板コードをマスターする
Sub 演習1()
Application.ScreenUpdating = False
Dim i As Long
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(i, 6) = Left(Cells(i, 1), 4)
Cells(i, “G”) = WorksheetFunction.VLookup( _
Cells(i, 2), Sheets(2).Range(“E:F”), 2, 0)
If Cells(i, 5) >= 500000 Then
Cells(i, 8) = “A”
Else
Cells(i, 8) = “B”
End If
Next i
End Sub
オートフィルタや並べ替えなどの必須機能
Sub オートフィルタ()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim i As Long
With Sheets(“オートフィルタ-削除”)
For i = 6 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 3) >= 80 Then
.Cells(i, 4) = “A”
Else
.Cells(i, 4) = “B”
End If
Next i
.Range(“A5″).AutoFilter field:=4, Criteria1:=”B”
.Range(“A5″).CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).Delete
.Range(“A5″).AutoFilter
End With
End Sub
Sub 並べ替え()
Application.ScreenUpdating = False
With Sheets(“並べ替え”)
.Range(“A5″).Sort key1:=.Range(“D5″), order1:=xlAscending, _
key2:=.Range(“C5″), order2:=xlDescending, Header:=xlYes
End With
End Sub
マクロを実行する前にフォーマットを初期化するテクニック
Sub 一行目削除初期化()
Range(“A5″).CurrentRegion.Offset(1, 0).ClearContents
End Sub
データに一行おきに新規行を入れるにはForNextを逆から回す発想が必須
Sub 一行おきに挿入()
Dim i
For i = 25 To 6 Step -1
Rows(i).Insert
Next i
End Sub
フォルダ内のファイル名一覧表を作成する
Sub ファイル名一覧表()
Application.ScreenUpdating = False
Dim i As Long, filename As String
With Sheets(“ファイル名一覧表”)
.Columns(1).ClearContents
filename = Dir(ThisWorkbook.Path & “\勤怠管理表\201206_勤怠管理表\*”)
i = 1
Do While filename <> “”
.Cells(i, 1) = filename
i = i + 1
filename = Dir()
Loop
End With
End Sub
複数のファイルやシートを扱う面倒な作業を自動化瞬殺する演習の数々…
Sub 残業時間処理()
Application.ScreenUpdating = False
Call ファイル名一覧表
Dim i As Long, r As Long
Dim f As Worksheet
Set f = Sheets(“ファイル名一覧表”)
With Sheets(“担当者別残業時間一覧”)
.Range(“A5″).CurrentRegion.Offset(1, 0).ClearContents ‘初期化
r = 6
For i = 1 To f.Cells(Rows.Count, 1).End(xlUp).Row
Workbooks.Open ThisWorkbook.Path & “\勤怠管理表\” & _
.Range(“B3″) & “_勤怠管理表” & f.Cells(i, 1)
.Cells(r, 1) = Range(“D1″)
.Cells(r, 2) = Range(“G38″)
ActiveWorkbook.Close
r = r + 1
Next i
End With
End Sub
Sub 新規勤怠管理作成()
Application.ScreenUpdating = False
Dim i As Long, ID As Long
Dim m As Worksheet
Set m = Sheets(“社員マスタ”)
With Sheets(“雛形”)
ID = .Range(“A3″) & Format(.Range(“A4″), “00″)
MkDir ThisWorkbook.Path & “\” & ID & “_勤怠管理表”
For i = 2 To m.Cells(Rows.Count, 1).End(xlUp).Row
.Range(“D1″) = m.Cells(i, 1)
.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & “\” & ID & “_勤怠管理表\” _
& ID & “_” & Range(“D1″) & “.xlsx”
ActiveWorkbook.Close
Next i
End With
MsgBox “完了しました”
End Sub
Sub 請求書作成()
Application.ScreenUpdating = False
Call 請求書削除
Dim i As Long
With Sheets(“●請求台帳”)
For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 2) <> “” Then
Sheets(“●請求書”).Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = .Cells(i, 3)
Range(“A3″) = .Cells(i, 3)
End If
Next i
End With
End Sub
Sub 請求書削除()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.Save
Dim i As Long
For i = Sheets.Count To 1 Step -1
If Sheets(i).Name Like “●*” Then
Else
Sheets(i).Delete
End If
Next i
End Sub