takayukisの日記 このページをアンテナに追加 RSSフィード

2018.04.26(木)

[]倍率を100に設定

やたら拡大していたり縮小している人がいる場合に。

Sub 倍率を100に設定()
    Dim ブック As Workbook
    Set ブック = ActiveWorkbook
    Dim 選択シート As Worksheet
    Set 選択シート = ActiveSheet
    Dim シート As Worksheet
    Dim update As Boolean
    update = Application.ScreenUpdating
    Application.ScreenUpdating = False
    For Each シート In ブック.Worksheets
        シート.Activate
        ActiveWindow.Zoom = 100
    Next
    選択シート.Activate
    Application.ScreenUpdating = update
End Sub

[]差の式を入力

セルの左2列の差を求める式をセルに設定します。

Sub 差の式を入力()
    Dim 範囲 As Range
    Set 範囲 = Selection
    Dim1 As Range
    Set1 = 範囲.Offset(0, -1)
    Dim2 As Range
    Set2 = 範囲.Offset(0, -2)
    範囲.Formula = "=" &1.Address(RowAbsolute:=False, ColumnAbsolute:=False, ReferenceStyle:=xlA1) & "-" &2.Address(RowAbsolute:=False, ColumnAbsolute:=False, ReferenceStyle:=xlA1)
End Sub

[]先頭行を固定してフィルタを設定

Sub 先頭行を固定してフィルタ()
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    Selection.AutoFilter
End Sub

[]シート名の一覧

シート名の一覧をセルに出力します。

Sub シート名の一覧()
    Dim 更新状態
    更新状態 = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Set 範囲 = Selection
    Dim カウンタ As Long
    カウンタ = 0
    DimAs Range
    For Each i In ActiveWorkbook.Sheets
        Set= 範囲.Offset(カウンタ, 0).Value = i.Name
        カウンタ = カウンタ + 1
    Next i
    Application.ScreenUpdating = 更新状態
End Sub

[]選択したシートをCSVで保存

ネットでよく見かけるのは、アクティブなシートだけを保存するコードですが、これは複数選択したシートをすべてCSVで出力します。

Sub 選択シートをCSVで保存()
    Dim ブック As Workbook
    Set ブック = ActiveWorkbook
    Dim フォルダ As String
    フォルダ = ブック.Path
    Dim パス As String

    Dim シート As Worksheet
    Dim シート名 As String
    For Each シート In ActiveWindow.SelectedSheets
        シート名 = シート.Name
        パス = フォルダ & "\" & シート名 & ".csv"
        シート.Copy
        ActiveWorkbook.SaveAs Filename:=パス, FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close savechanges:=False
    Next
End Sub