作業を楽にするマクロ一覧
以下のリンクで各マクロへジャンプできます。
下記サイトを参考にして、ショートカットを割り当てると便利に使えます。ご使用ください。
http://www.relief.jp/itnote/archives/001490.php
選択シートコピー
Sub 選択シートコピー()
'
' 選択シートコピー Macro
'
'
ActiveSheet.Copy After:=Sheets(ActiveWorkbook.Worksheets.Count)
Range("A1").Select
End Sub
アクティブブックの全シートのカーソルを左上移動
Excelを開いたときにカーソルがバラバラで参照しづらい時に使います。全シートのカーソルを左上に移動して、ブックを保存します。
Sub カーソル左上移動()
'
' カーソル左上移動 Macro
'
Dim WS_Count As Integer
Dim i As Integer
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For i = 1 To WS_Count
Worksheets(i).Select
Cells(8, 1).Select '分割下領域もカーソルを左上へ移動
Cells(1, 1).Select
Next i
Worksheets(1).Select
ActiveWorkbook.Save
End Sub
選択範囲のセル範囲全体に罫線
Sub セル範囲全体に罫線()
'
' セル範囲全体に罫線 Macro
'
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
選択範囲のセル範囲全体に罫線解除
Sub セル範囲全体に罫線解除()
'
' セル範囲全体に罫線 Macro
'
With Selection.Borders
.LineStyle = xlNone
End With
End Sub
コピーしたセルの値のみを貼り付ける
Sub 値貼り付け()
'
' 値貼り付け Macro
'
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
オブジェクト全選択
吹き出しとかコメントとか全てのオブジェクトを選択する。
Sub オブジェクト全選択()
'
' オブジェクト全選択 Macro
'
ActiveSheet.DrawingObjects.Select
End Sub
選択しているオブジェクトを最背面にする
Sub 最背面()
'
' 最背面 Macro
'
Selection.ShapeRange.ZOrder msoSendToBack
End Sub
VBAの修正差分を確認するためにモジュールをテキストに書き出す
Sub Module書出()
' 使用用途:VBAの修正差分確認用
' VBA モジュールの書き出し
Dim Project, objxl As Object
Dim DirName As String
Const Path As String = "C:\tmp\"
'Topディレクトリ作成
If Dir(Path, vbDirectory) = "" Then
MkDir Path
End If
For Each objxl In Application.Workbooks
If objxl.Name = "PERSONAL.XLSB" Or objxl.Name = "B" Then
GoTo Continue
End If
DirName = Path & Left(objxl.Name, Len(objxl.Name) - 4) & "\"
MkDir DirName
For Each Project In objxl.VBProject.VBComponents
Project.Export DirName & Project.Name & ".bas"
Next
Continue:
Next
End Sub
選択シート複数コピー_連番シート名
Sub 選択シート複数コピー_連番シート名()
Prefix = "TCP"
CopySheetNum = 18
For i = 1 To CopySheetNum
ActiveSheet.Copy After:=Sheets(ActiveWorkbook.Worksheets.Count)
Range("A1").Select
ActiveSheet.Name = Prefix & i
Next i
End Sub
シート内情報全クリア
Sub シート内情報全クリア()
'
' シート内情報全クリア Macro
' 文字列、表の枠組み、色づけ、フォント(11ptにする)を全クリアする
'
' Keyboard Shortcut: Ctrl+Shift+N
'
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.TintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Selection.ClearContents
Range("A1").Select
End Sub
空行の挿入
Sub 空行の挿入()
'
' 空行の挿入 Macro
' カーソルがある行に空行の挿入
'
' Keyboard Shortcut: Ctrl+i
'
Dim rowNum As Long
Dim address As String
' 選択位置を取得
address = Selection.address
' 行番号を取得
rowNum = Selection.Row
Rows(rowNum & ":" & rowNum).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range(address).Select
End Sub
行削除
Sub 行削除()
'
' 行削除 Macro
' カーソルがある行を削除
'
' Keyboard Shortcut: Ctrl+Shift+d
'
Dim rowNum As Long
Dim address As String
' 選択位置を取得
address = Selection.address
' 行番号を取得
rowNum = Selection.Row
Rows(rowNum & ":" & rowNum).Select
Selection.Delete Shift:=xlUp
Range(address).Select
End Sub
URLリンク化
Sub URLリンク化()
'
' URLリンク化 Macro
' URL文字列セルをリンク化して、下の行のセルに移動する
'
' Keyboard Shortcut: Ctrl+Shift+L
'
Dim row_num As Long
Dim col_num As Long
Dim val As String
row_num = ActiveCell.Row
col_num = ActiveCell.Column
val = ActiveCell.Value
ActiveSheet.Hyperlinks.Add Anchor:=Cells(row_num, col_num), address:=val
Cells(row_num + 1, col_num).Select
End Sub
Sub ハイパーリンクを開く()
'
' ハイパーリンクを開く Macro
' セル内ハイパーリンクを開く
'
' Keyboard Shortcut: Ctrl+Shift+H
'
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
End Sub