[[excel2010 マクロVBA 導入 手順]]
#contents
エラー処理とかはしていないので条件によってはVBAのエラーが出て止まってしまいます。
実行する前にセーブしておきましょう。
* excelの便利マクロ [#wee5bb42]
** キーに割り当てると便利 [#xdf113ce]
*** タイムスタンプを記録 [#b3cd742f]
日付と時刻をセルに入力します。
Sub timestamp2()
ActiveCell.FormulaR1C1 = "=NOW()"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub
備考: 日付や時刻の挿入はそれぞれCtrl+":"やCtrl+";"でできます。
*** 新しいシートを固定幅フォントで作成 [#bc1c8469]
新しいシートを作成しフォントを固定幅、書式を文字列に設定します。
Sub AddNewSheetFormatString()
Sheets.Add After:=Sheets(Sheets.Count)
Cells.Select
Selection.NumberFormatLocal = "@"
Cells.Select
With Selection.Font
.Name = "ＭＳ ゴシック"
.FontStyle = "標準"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("A1").Select
ActiveCell.FormulaR1C1 = "書式を文字列、MSゴシックに設定しました。"
ActiveCell.Characters(1, 2).PhoneticCharacters = "ショシキ"
ActiveCell.Characters(4, 3).PhoneticCharacters = "モジレツ"
ActiveCell.Characters(15, 2).PhoneticCharacters = "セッテイ"
End Sub
*** 最後のシートを選択 [#m397bcb7]
Sub SelectLastSheet()
Worksheets(Worksheets.Count).Select
End Sub
*** 最初のシートを選択 [#i90b44bb]
Sub SelectFirstSheet()
Worksheets(1).Select
End Sub
*** 次のシートを選択 [#ybdeead4]
以下のコードは不要 Ctrl+PageDown で一発だった。VBAだと
ActiveSheet.Next.Select 1行。
Sub SelectNextSheet()
Dim i As Integer
i = 1
For Each s In Worksheets
If Worksheets(i).Name = ActiveSheet.Name Then
Exit For
End If
i = i + 1
Next s
If i < Worksheets.Count Then
Worksheets(i + 1).Select
End If
End Sub
*** 前のシートを選択 [#ec655ee6]
同様にCtrl+PageUpでok。VBAでは
ActiveSheet.Previous.Select
Sub SelectPrevSheet()
Dim i As Integer
i = 1
For Each s In Worksheets
If Worksheets(i).Name = ActiveSheet.Name Then
Exit For
End If
i = i + 1
Next s
If Worksheets(i).Name = ActiveSheet.Name And i > 1 Then
Worksheets(i - 1).Select
End If
End Sub
*** 選択された領域を削除し上へ詰める [#q4b4b440]
Sub DeleteCellAndUp()
Selection.Delete Shift:=xlUp
End Sub
*** 現在行を削除 [#n60a9f1e]
Sub DeleteRow()
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
End Sub
*** 現在セルから下方向の一連のセルを右へ移動 [#m1457063]
Sub RowsToRight()
Range(Selection, Selection.End(xlDown)).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
*** 現在行の下に行を追加 [#p0d64136]
Sub InsertRowDown()
c = ActiveCell.Column
r = ActiveCell.Row
x = ActiveCell
Rows(ActiveCell.Row + 1).Select
Selection.Insert
Cells(r + 1, c).Select
End Sub
*** 現在行に行を追加 [#m8439eab]
Sub InsertRow()
c = ActiveCell.Column
r = ActiveCell.Row
x = ActiveCell
Rows(ActiveCell.Row).Select
Selection.Insert
Cells(r, c).Select
End Sub
*** 値を貼り付け [#o71a4ec6]
Sub PasteValues()
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub
** ブックの構成を整えるのに便利 [#ye0b7353]
*** シート一覧を作成 [#f4d23844]
カレントセルから下へシートの一覧を作成します。各シートのA1へのリンクが付きます。
Sub ListSheets()
Dim r As Integer
r = 0
For Each s In Worksheets
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(r), Address:="", _
SubAddress:="'" + s.Name + "'!A1", TextToDisplay:=s.Name
r = r + 1
Next s
End Sub
*** ファイル名一覧からシート一覧を作成 [#te91c136]
シート1のセルA1から絶対パス表記でのブック一覧からシート2にブック/シート一覧を作成します。
Sub ListFilesAndSheets()
Dim bb As Workbook
Set bb = ActiveWorkbook
Worksheets(1).Select
Dim ss(999) As String
f = 1
r = 1
Do While Cells(f, 1).Value <> ""
fn = Cells(f, 1).Value
Workbooks.Open Filename:=fn, UpdateLinks:=False, ReadOnly:=True
ns = Worksheets.Count
i = 0
For Each s In Worksheets
i = i + 1
ss(i) = s.Name
Next s
ActiveWorkbook.Close SaveChanges:=False
bb.Activate
Worksheets(2).Select
Cells(r, 1).Value = fn
r = r + 1
For i = 1 To ns
ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 2), Address:=fn, _
SubAddress:="'" + ss(i) + "'!A1", TextToDisplay:=ss(i)
r = r + 1
Next
Worksheets(1).Select
f = f + 1
Loop
End Sub
1番目と2番目のシートはこのマクロのためにあらかじめ用意してください。
ファイル名一覧はコマンドプロンプトで
dir /b /s *.xls* > filelist.txt
するとテキストファイルとして得られるのでそれを張り付けています。
マクロでフォルダを指定できるようにするのがいいでしょう。
*** シート名の一括置き換え [#g0dfec18]
1番目のシートのA2に元のシート名、B3の新しいシート名のように記入した表を
作ってください。マクロを実行するとシート名を一括で置き換えます。
Sub MovSheet()
r = 2
Do While Cells(r, 1).Value <> ""
ActiveWorkbook.Sheets(r).Name = " " & r
r = r + 1
Loop
r = r - 1
Do While r > 1
If Cells(r, 2).Value = "" Then
ActiveWorkbook.Sheets(r).Name = Cells(r, 1)
ElseIf Cells(r, 3).Value = "" Then
ActiveWorkbook.Sheets(r).Name = Cells(r, 2)
ElseIf Cells(r, 4).Value = "" Then
Set wb = ActiveWorkbook
sn = Cells(r, 2)
ActiveWorkbook.Sheets(r).Name = sn
ActiveWorkbook.Sheets(r).Copy _
before:=Workbooks(Cells(r, 3).Value).Worksheets(1)
wb.Activate
ElseIf Cells(r, 4).Value = "MOVE" Then
Set wb = ActiveWorkbook
sn = Cells(r, 2)
ActiveWorkbook.Sheets(r).Name = sn
ActiveWorkbook.Sheets(r).Move _
before:=Workbooks(Cells(r, 3).Value).Worksheets(1)
wb.Activate
End If
r = r - 1
ActiveWorkbook.Sheets(1).Select
Loop
End Sub
C列にブック名を入力すると該当シートを指定されたブックにコピーします。
D列に"MOVE"と指定があると移動になります。
** その他 [#aa83003d]
*** 文字列を指定幅で分割 [#b32743c9]
[[文字列を指定幅で分割する]]
![[PukiWiki]](image/pukiwiki.png "[PukiWiki]")
