【Excel】〜作業効率UPマクロ作ってみた〜

A1を選択する

エクセルを扱う作業が多い会社はルールで
・１シート目を表示した状態で保存する
・A1セルを選択した状態で保存する
とか定められていることも多いのではないでしょうか。

社内にルールに限らず、顧客に出す資料とかも
開いたときに中途半端なシートが表示されるより、1番目のシートが表示されたほうがなんかいいですよね。

そんなときに使えるのがこちらです。

全シートのA1を選択して、最初のシートを表示した状態にしてくれます。
ショートカット登録して保存前に初期状態に戻しましょう。

Sub SelectA1()
Dim wb As Workbook
Dim i As Long

Set wb = ActiveWorkbook

For i = 1 To wb.Sheets.Count
    wb.Sheets(i).Activate
    Cells(1, 1).Select
Next i

wb.Sheets(1).Activate

End Sub

R1C1とA1表示の切り替え

A~Z列までであれば、[F5]と書かれても、
「5列目の5行目のセルだ」とかわかりますが、[AQ5]とか分からないですよね。
マクロとか関数使う人ならcolumn(AQ5)とか使って列番号取得できると思いますが、
・マクロも関数もめんどくさい
・オプションから表示切り替えもめんどくさい
そんな時におすすめなのがこちら。

A1表示とR1C1表示の切り替えを行えます。
R1C1表示にすると、1列目が「A」と表示されていたところが、「1」と表示されるようになります。

Sub ChangeReferenceStyle()

If Application.ReferenceStyle = xlA1 Then
    Application.ReferenceStyle = xlR1C1
Else
    Application.ReferenceStyle = xlA1
End If

End Sub

フォルダ内のファイルを取得

エクセルファイルの置かれているファイルパスに存在している、
ファイルの名前とパスを取得して、「一覧YY-MM-DD_HHmmss」というシートを作成して
整理してくれるマクロ。

取得時時点でそのフォルダに何が格納されていたかの確認ができるため、
何が増えたか、減ったかなどの確認のためにたまに使用します。

コードの最後に自動セル幅調整入れてます。

Sub GetFilesInThisWBPath()
Dim wb_path As String
Dim file_name As String
Dim ws As Worksheet
Dim loop_counter As Long

wb_path = ThisWorkbook.path
file_name = Dir(wb_path & Application.PathSeparator)
Set ws = ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = "一覧" & Format(Date, "yy-mm-dd") & "_" & Hour(Time) & Minute(Time) & Second(Time)
loop_counter = 2
ws.Cells(1, 1).Value = "ファイル名"
ws.Cells(1, 2).Value = "path"
Do While file_name <> ""
    ws.Cells(loop_counter, 1).Value = file_name
    ws.Cells(loop_counter, 2).Value = ThisWorkbook.path & Application.PathSeparator & file_name
    file_name = Dir()
    loop_counter = loop_counter + 1
Loop
ws.Range(Cells(1, 1), Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column)).EntireColumn.AutoFit

End Sub

先程までのはWBの存在するフォルダ内のみでしたが、
入力された階層下の全ファイルを取得したい場合等はこちらを使用しています。

Dim rowcnt As Long    'グローバル変数
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub GetFiles()
Dim ws As Worksheet
Dim inputpath As String

inputpath = Application.InputBox(prompt:="ルートパスを入力してください。", Title:="ファイル一覧作成", Type:=2)
Select Case inputpath
    Case "False"
        MsgBox "処理が中断されました。"
        Exit Sub
    Case ""
        MsgBox "パスが入力されませんでした。"
        Exit Sub
    Case Else
        Set ws = ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
        ws.Name = "一覧" & Format(Date, "yy-mm-dd") & "_" & Hour(Time) & Minute(Time) & Second(Time)
        rowcnt = 0
        Call GetAllFilesInPath(inputpath)
        ActiveSheet.Range(Cells(1, 1), Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column)).EntireColumn.AutoFit
    End Select
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub GetAllFilesInPath(path As String)
Dim buf As String, f As Object

buf = Dir(path & Application.PathSeparator & "*.*")
Do While buf <> ""
    If rowcnt = 0 Then
       Cells(1, 1).Value = "link"
       Cells(1, 2).Value = "ファイル名"
       Cells(1, 3).Value = "path"
       Cells(1, 4).Value = "変更名"
       rowcnt = rowcnt + 1
    End If
    rowcnt = rowcnt + 1
    Cells(rowcnt, 1) = ">>"
    Set hl = ActiveSheet.Hyperlinks.Add(Anchor:=Range("A" & rowcnt), Address:=path)
    Cells(rowcnt, 2) = buf
    Cells(rowcnt, 3) = path
    buf = Dir()
Loop
With CreateObject("Scripting.FileSystemObject")
    For Each f In .GetFolder(path).SubFolders
       Call GetAllFilesInPath(f.path)
    Next f
End With
End Sub