2026-02-15

行や幅のサイズをセンチ単位で設定

Excel メモ

Excel画面右下のページレイアウトを選択。

こんな画面。

列を選択して列幅の設定をしてみる。センチ表示になっている！

2cmに設定してみる。

開いて確認。百分台は誤差です。OK。

念のため測りました。
Excel画面上でアプリのルーラーや物理定規で測ると、行も列も設定したセンチ単位で出来てます。

印刷してみると、設定した行の高さよりも短くなりました。なぜだ。
行の高さ1cmが0.9cm、2cmは1.8cm、約90%のサイズで印刷されています。
列幅は大丈夫。

他プリンタが無く試せていないので私の環境の問題かもしれません。プリンタの送りが摩耗？劣化？印刷の向きで変わる？
PDF出力は紙の検証と同じ結果でした。

1割なら誤差。以上。

2026-02-11

保存確認を表示しない

Excel VBA

これを表示したくない時がある。

Sub テスト()
    
    Dim flgAppSaved As Boolean
    flgAppSaved = ThisWorkbook.Saved
    
    '～～～～  何かしらの処理  ～～～～
    
    ThisWorkbook.Saved = flgAppSaved
    
End Sub

フラグを保存して後で復元すると、上記の処理だけの場合は保存確認を表示しない。上記以外でファイルに更新を行っていれば保存確認が表示される。

以上。

2026-02-10

オートフィルタの結果から列データを取得

Excel VBA オートフィルタ

蓄積データをオートフィルタで絞り、印刷用シートにコピペする業務がある。この時いらない列データがあるので一手間いる。必要な列のデータだけを取りたい。

Sub 列ごとにデータを取り出すテスト()
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    ws.Range("A2").AutoFilter Field:=2, Criteria1:="*費*"
    
    '迷子対策
    ws.Range("A3").Select
    ActiveWindow.ScrollRow = ActiveCell.Row
    
    'タイトル行を除くデータ範囲
    Dim rngData As Range
    With ws.Range("A2").CurrentRegion
        Set rngData = ws.Range("A3", .item(.Count))
    End With
    
    '可視範囲（オートフィルタの結果）
    Dim rngVisible As Range
    Set rngVisible = rngData.SpecialCells(xlCellTypeVisible)
    
    'データ範囲かつ可視セルが選択される確認
    'rngVisible.Select
    
    '試しに1列選択してみると、全然足りないことが確認できる
    'rngVisible.Columns(1).Select
    
    '以下、列ごとのセットに組み替える処理
    ReDim rngColumns(rngVisible.Columns.Count) As Range
    Dim i As Long, r As Range
    
    For i = 1 To rngVisible.Areas.Count
        For Each r In rngVisible.Areas(i)
            
            If rngColumns(r.Column) Is Nothing Then
                Set rngColumns(r.Column) = r
            Else
                Set rngColumns(r.Column) = Union(rngColumns(r.Column), r)
            End If
            
        Next
    Next i
    
    '列が取得できることを確認
'    rngColumns(2).Select
'    Union(rngColumns(3), rngColumns(5)).Select
    
    Set ws = Nothing
    
End Sub

列ごとに範囲選択できる所まで組んだので、あとは印刷用シートに必要な列データを選んでぶん投げるだけです。Union便利！

オートフィルタの結果をコピーして新規シートに張り付け、そこから必要行や列を取得する方がExcelらしい気がします。

以上。

2025-02-03

表末尾に選択行を切り取り貼り付け

Excel VBA

切り取り貼り付けする度に、行が多くて何度もスクロールするのが嫌で作った。
選択するのはセルでも行でもOK。行を選択する手間が省けた。
いちいちスクロールすることなく末尾にヒョイヒョイ行を投げられる。
（そもそも表の構造がおかしい点は無視）

Sub 選択行を末尾に切り取り貼り付け()
    
    '最終行+1の取得（貼り付けする行）
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim insertRow As Long
    insertRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
    'Debug.Print insertRow
    
    '選択行（セル）の検出
    Dim r As Range, rng As Range
    For Each r In Selection.Rows
        If rng Is Nothing Then
            Set rng = r.EntireRow
        Else
            Set rng = Union(rng, r.EntireRow)
        End If
    Next
    'Debug.Print rng.AddressLocal
    'Debug.Print rng.Areas.Count
    
    If rng.Areas.Count = 1 Then
        ws.Rows(rng.Address).Cut
        ws.Rows(insertRow).Insert
    Else
        MsgBox "離れた行の切り取り貼り付けは未対応です。"
        'エリア毎にやれば可能。行数の計算に注意。
    End If
    
End Sub

以上。

2025-01-30

縮小して全体を表示しているセルを一括選択

Excel VBA

折り返して表示が混同設定されているパターンは考慮してません。
また、Unionの個数やRangeの指定文字数でエラーになる事があるらしいです。それも考慮してません。

Sub 縮小して全体を表示しているセルを一括選択()
    
    Dim r As Range, ur As Range
    
    For Each r In ThisWorkbook.Worksheets("Sheet1").UsedRange
        If r.ShrinkToFit = True Then
            If ur Is Nothing Then
                Set ur = r
            Else
                Set ur = Union(ur, r)
            End If
        End If
    Next
    
    If Not ur Is Nothing Then
'        Debug.Print ur.Count        '確認用
'        Debug.Print ur.AddressLocal '確認用
        ur.Select
    End If
    
End Sub