【マクロ】エクセルの行列幅のみコピペ

通常では形式の貼り付けで列幅だけは貼り付けられるが、
行幅だけはコピペ出来ない。

まずは貼り付けたい箇所を選択し下記のマクロを実行する。
貼り付け先を指定するインプットボックスが出るので
直接入力するか、貼りたい場所をクリックする。
A1：G50を選択し、貼り付け先をB1にする。
この時は行幅だけ反映される。
A1：G50を選択し、貼り付け先をB列を指定する。
これで行、列幅共に反映される。

※貼り付け先を別ブックでも指定できるが行幅だけしか反映されないので
　貼り付け後に形式を選択して貼り付けで列幅を貼ればよい。

Sub 列幅も行高もコピー()
    'コピーする範囲を選択してから実行
    Dim i As Long
    Dim gyosu As Long
    Dim myRange As Range
    Dim doko As Range
    Dim saki As Range
    Set myRange = Selection
    gyosu = myRange.Rows.Count
    ActiveSheet.Select
    Set doko = Application.InputBox("コピー先の先頭セルを選択", Type:=8)
    Set saki = doko.Resize(gyosu, myRange.Columns.Count)
    myRange.Copy
    Range(doko.Address).Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteColumnWidths
    Application.CutCopyMode = False
    For i = 1 To gyosu
        saki.Rows(i).RowHeight = myRange.Rows(i).RowHeight
    Next
End Sub

【マクロ】エクセル マクロ 範囲を拡張して消す

A列で任意の範囲を選択しdeleteキーを押すと
同範囲の隣の列も消す。

例えば、A5からA10まで選択し値を消す。
B5からD10までの値も同様に消したい。
A15からA50までを選択し消せば
B15からD50も消える。
A20を消せばB20からD20も消える。

選択する範囲は必ずA列のどこかで
消すときに値のみ消す。

シートモジュール
Private Sub Worksheet_Change(ByVal Target As Range)
　Dim c As Range
　　If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
　　If Target.Count <= 1000 Then 
　　　Application.EnableEvents = False
　　　　For Each c In Target
　　　　　If c = "" Then
　　　　　　c.Offset(, 1).Resize(, 3).ClearContents
　　　　　End If
　　　　Next c
　　　Application.EnableEvents = True
　　End If
End Sub

ファイルのアップ方法

Bolggerにファイルをアップする方法

参照サイト

グーグルサイト

【マクロ】フィルター状況を調べる

オートフィルターが絞り込まれているか調べる。

Sub Sample7()
    If ActiveSheet.AutoFilterMode Then
        If ActiveSheet.AutoFilter.FilterMode Then
            MsgBox "絞り込まれています"
        Else
            MsgBox "絞り込まれていません"
        End If
    End If
End Sub



Sub Sample8()
    Dim n As Long
    If ActiveSheet.AutoFilterMode Then
        n = ActiveSheet.AutoFilter.Filters.Count
        MsgBox n & "列のフィルタがあります"
    End If
End Sub



上記の方法では、テーブルの場合は機能しない。
そこで
ActiveSheet.AutoFilter.FilterMode を ActiveSheet.ListObjects(1).ShowAutoFilter に変える。 Sub Sample9()
    If ActiveSheet.ListObjects(1).ShowAutoFilter Then
        If ActiveSheet.AutoFilter.FilterMode Then
            MsgBox "絞り込まれています"
        Else
            MsgBox "絞り込まれていません"
        End If
End If
End Sub
これでテーブルでも機能する。

【マクロ】表に簡単に罫線をひく

下記参考
【エクセルVBA】表の範囲全体に格子状の罫線を引く最も簡単な方法

【マクロ】テーブルのフィルターで絞り込んだ値

フィルターでどの項目で何を絞ったかを抽出する。
テーブルシートでマクロ実行をすること。
グラフシートのH列31行目に値を返している。


Sub フィルターリスト()
Application.ScreenUpdating = False
Worksheets("グラフ").Select
Range("H31", Cells(Rows.Count, 8).End(xlUp)).ClearContents

Worksheets("テーブル").Select
Range("A1").Select
Dim srcWS As Worksheet
Set srcWS = ActiveSheet
Dim dstWS As Worksheet
Set dstWS = Worksheets("グラフ")

Dim i As Long
Dim r As Long
r = 31
With srcWS.AutoFilter
For i = 1 To .Filters.Count
If .Filters(i).On = True Then
If .Filters(i).Operator <> 0 Then
If .Filters(i).Operator = xlFilterValues Then
dstWS.Cells(r, "H").Value = .Range.Cells(1, i).Value & "：" & Join(.Filters(i).Criteria1, ",")
Else
dstWS.Cells(r, "H").Value = .Range.Cells(1, i).Value & "：" & .Filters(i).Criteria1 & " と " & .Filters(i).Criteria2
End If
Else
dstWS.Cells(r, "H").Value = .Range.Cells(1, i).Value & "：" & .Filters(i).Criteria1
End If
r = r + 1
End If
Next
End With
'上記の返値から=を消す
Worksheets("グラフ").Select
Range("H30") = "【下記で絞ってます】"
Range("H31", Cells(Rows.Count, 8).End(xlUp)).Select
Selection.Replace What:="=", Replacement:=""
Application.ScreenUpdating = True
End Sub

【マクロ】アクティブ行列に色を付けて見やすくする

色を自動的に表示させたいシート全体を選択し
条件付き書式で数式を=CELL("row")=ROW()
書式で色や罫線を指定する。

=CELL("col")=COLUMN()とすれば列に対して色が付く。
=OR(CELL("row")=ROW(), CELL("col")=COLUMN())とすれば行列両方に対して色が付く。


マクロコード
ThisWorkbookに下記を書き込む。
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.ScreenUpdating = True
End Sub