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

フィルターでどの項目で何を絞ったかを抽出する。
テーブルシートでマクロ実行をすること。
グラフシートの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

【マクロ】特定の文字含まれていればフラグを立てる

E列で特定の文字を含むセルを探し、隣のF列にフラグを立てる

E列に週を含む文字があれば、F列に1を、

無ければ0を返す。

For i = 2 To ActiveSheet.Range("E2").End(xlDown).Row
If ActiveSheet.Cells(i, 5).Value Like "*週" Then
ActiveSheet.Cells(i, 6).Value = 1
Else
ActiveSheet.Cells(i, 6).Value = 0
End If
Next i

【マクロ】Ctrl+Dとオートフィル

1行目が項目で2行目からデータを入れていく。

A列で範囲を指定しCtrl+Dでオートフィルを自分でやる
ffddマクロを実行すると下記表の様にA列の値が入っている範囲で
B～I列は2行目と同じ値を入れる。
そしてJ列には連番を入れる。
この時にはJ２セルには基準となる番号を入れておくこと。

A３の値が変わるとffddを実行するコード
Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Intersect(Target, Range("A3")) Is Nothing) Then ffdd
End Sub



Sub ffdd()
If Range("A3") = "" Then
Else
    '上の値をコピペ　Ctrl+D
    Range("B2:I" & Cells(Rows.Count, 1).End(xlUp).Row).Select
    Selection.FillDown
    'J2の番号を見て連番を振る。
    Range("J2").AutoFill Destination:=Range("J2:J" & Cells(Rows.Count, 1).End(xlUp).Row), Type:=xlFillSeries
End If
End Sub

	A	B	C	D	E	F	G	H	I	J
１	年	月	日	曜日	名称	市	地区	自治区等	旧市町村	番号
２	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		10

	A	B	C	D	E	F	G	H	I	J
１	年	月	日	曜日	名称	市	地区	自治区等	旧市町村	番号
２	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		10
3	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		11
4	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		12
5	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		13
6	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		14
7	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		15
8	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		16
9	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		17
10	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		18
11	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		19
12	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		20
13	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		21
14	2018	4	1	日	陸海空	アマゾン	3丁目	洞穴		22