excelの便利マクロ

excel2010 マクロVBA　導入　手順

エラー処理とかはしていないので条件によってはVBAのエラーが出て止まってしまいます。 実行する前にセーブしておきましょう。

excelの便利マクロ †

キーに割り当てると便利 †

タイムスタンプを記録 †

日付と時刻をセルに入力します。

Sub timestamp2()
    ActiveCell.FormulaR1C1 = "=NOW()"
    Selection.Copy
   Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
End Sub

備考: 日付や時刻の挿入はそれぞれCtrl+":"やCtrl+";"でできます。

新しいシートを固定幅フォントで作成 †

新しいシートを作成しフォントを固定幅、書式を文字列に設定します。

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

最後のシートを選択 †

Sub SelectLastSheet()
  Worksheets(Worksheets.Count).Select
End Sub

最初のシートを選択 †

Sub SelectFirstSheet()
  Worksheets(1).Select
End Sub

次のシートを選択 †

以下のコードは不要 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

前のシートを選択 †

同様に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

選択された領域を削除し上へ詰める †

Sub DeleteCellAndUp()
  Selection.Delete Shift:=xlUp
End Sub

現在行を削除 †

Sub DeleteRow()
  Rows(ActiveCell.Row).Select
  Selection.Delete Shift:=xlUp
End Sub

現在セルから下方向の一連のセルを右へ移動 †

Sub RowsToRight()
  Range(Selection, Selection.End(xlDown)).Select
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

現在行の下に行を追加 †

Sub InsertRowDown()
  c = ActiveCell.Column
  r = ActiveCell.Row
  x = ActiveCell
  Rows(ActiveCell.Row + 1).Select
  Selection.Insert
  Cells(r + 1, c).Select
End Sub

現在行に行を追加 †

Sub InsertRow()
  c = ActiveCell.Column
  r = ActiveCell.Row
  x = ActiveCell
  Rows(ActiveCell.Row).Select
  Selection.Insert
  Cells(r, c).Select
End Sub

値を貼り付け †

Sub PasteValues()
 
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
End Sub

ブックの構成を整えるのに便利 †

シート一覧を作成 †

カレントセルから下へシートの一覧を作成します。各シートの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

ファイル名一覧からシート一覧を作成 †

シート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

するとテキストファイルとして得られるのでそれを張り付けています。 マクロでフォルダを指定できるようにするのがいいでしょう。

シート名の一括置き換え †

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"と指定があると移動になります。

その他 †

文字列を指定幅で分割 †

文字列を指定幅で分割する