【マクロ・VBA】特定の文字を含むデータをカウントする

Sub 特定の文字を含むカウント()
  Dim intForwardMatch As Integer  '前方一致
  Dim intBackwardMatch As Integer '後方一致
  Dim intForwBackMatch As Integer '前方後方
  Dim intPerfectMatch As Integer  '完全一致
  
  intForwardMatch = WorksheetFunction.CountIf(Range("A1:A6"), "*東京店") '前方一致数
  intBackwardMatch = WorksheetFunction.CountIf(Range("A1:A6"), "東京店*") '後方一致数
  intForwBackMatch = WorksheetFunction.CountIf(Range("A1:A6"), "*東京店*") '前方後方一致数
  intPerfectMatch = WorksheetFunction.CountIf(Range("A1:A6"), "東京店")
  
  Dim n As Long  '空白以外
  n = WorksheetFunction.CountIf(Range("A1:A10"), "<>")
  MsgBox n
  
  MsgBox "前方一致数：" & intForwardMatch & vbCrLf & _
         "後方一致数：" & intBackwardMatch & vbCrLf & _
         "前方後方一致数：" & intForwBackMatch & vbCrLf & _
         "完全一致数：" & intPerfectMatch
 MsgBox "完了"
End Sub

Sub カウント数を集計して新規シートに結果を転記()

Worksheets.Add(After:=ActiveSheet).Name = "→カウント" & "_" & VBA.Format(Now(), "h時mm分ss秒")
ActiveSheet.Previous.Select

Dim lastRow1 As Long, lastRow2 As Long
Dim i As Long, j As Long, myCnt As Long
  
With ActiveSheet.Next
    .Range("A1") = ActiveSheet.Range("A1").Value
    .Range("B1") = "カウント"
    lastRow1 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            
        For i = 2 To lastRow1

            myCnt = 0
            
            lastRow2 = .Cells(Rows.Count, 1).End(xlUp).Row
            For j = 1 To lastRow2
                    
                If .Cells(j, 1).Value = ActiveSheet.Cells(i, 1).Value Then
                    Exit For
                Else
                    myCnt = myCnt + 1
                End If
            
            Next j
                
                If myCnt = lastRow2 Then
                    .Cells(lastRow2 + 1, 1).Value = ActiveSheet.Cells(i, 1).Value
                End If
            
        Next i
        
End With
        
'カウント
For i = 2 To ActiveSheet.Next.Cells(Rows.Count, "A").End(xlUp).Row

    With ActiveSheet.Next.Cells(i, "A")
        .Offset(0, 1) = WorksheetFunction.CountIf(ActiveSheet.Range("C:C"), .Value)
    End With
    
Next

'空欄以外の数
ActiveSheet.Next.Cells(Rows.Count, "A").End(xlUp).Offset(2, 0) = "空欄以外"
ActiveSheet.Next.Cells(Rows.Count, "B").End(xlUp).Offset(2, 0) = WorksheetFunction.CountIf(ActiveSheet.Range("C:C"), "<>")

'項目数
ActiveSheet.Next.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = "項目行数"
ActiveSheet.Next.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0) = 1

'合計数
ActiveSheet.Next.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = "最終行数"
ActiveSheet.Next.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0) = lastRow1

'空欄数
ActiveSheet.Next.Cells(Rows.Count, "A").End(xlUp).Offset(-3, 0) = "空欄"
ActiveSheet.Next.Cells(Rows.Count, "B").End(xlUp).Offset(-3, 0) = lastRow1 - WorksheetFunction.CountIf(ActiveSheet.Range("C:C"), "<>")


MsgBox "完了"
End Sub

Sub カウント()

For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row

        With Cells(i, "C")
            .Offset(0, 2) = WorksheetFunction.CountIf(ActiveSheet.Range("C:C"), .Value)
        End With

Next

Cells(1, "C").Offset(0, 2) = "カウント"

Dim LastCell As Range
Set LastCell = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).End(xlToRight)

LastCell.AutoFilter Field:=3

MsgBox "完了"
End Sub