【マクロ】フィルター関連

フィルターをかけた箇所の項目名と何で絞ったかを抽出する。


Sub フィルター項目抽出()


Dim srcWS As Worksheet
Set srcWS = ActiveSheet

Dim dstWS As Worksheet
Set dstWS = Worksheets("Sheet3")


Dim i As Long
Dim r As Long
r = 2
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, "B").Value = Replace(.Range.Cells(1, i).Value & "：" & Join(.Filters(i).Criteria1, "･"), "=", "")
Else
dstWS.Cells(r, "B").Value = Replace(.Range.Cells(1, i).Value & "：" & .Filters(i).Criteria1 & "･" & .Filters(i).Criteria2, "=", "")
End If
Else
dstWS.Cells(r, "B").Value = Replace(.Range.Cells(1, i).Value & "：" & .Filters(i).Criteria1, "=", "")
End If
r = r + 1
End If
Next
End With
End Sub


上で抽出した値を区切るコード
"："で区切る。

Sub MojiBunkatu()
    Dim lr As Long
    Dim lc As Long
    Dim ar As Variant
    Dim i As Long
   
    lr = 2
    Do
        ar = Split(Cells(lr, 2), "：")
       
        i = 0
        For i = LBound(ar) To UBound(ar)
            Cells(lr, 3 + i) = ar(i)
        Next i
       
        lr = lr + 1
        If Cells(lr, 2) = "" Then
            Exit Do
        End If
    Loop
   
End Sub

最終的には上と下を合体させてひとつのマクロにするかな。