Sub sample()
MsgBox Sheets.Count
End Sub

Sub sample2()
Range(“D20″) = 10000
Cells(23, 4) = “すごい改善”
End Sub

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

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

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

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

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

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

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