| 
    
     |  | こんにちは 
 Sheet1のデータを配列に格納して列毎、要素毎にカウントしてSheet2に書き出してます。
 
 Sub test()
 Dim v  As Variant
 Dim vv As Variant
 Dim k  As Variant
 Dim h  As Long
 Dim i  As Long
 Dim j  As Long
 
 v = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
 j = UBound(v, 2)
 ReDim x(1 To j, 1 To 1)
 
 For i = 1 To j
 vv = WorksheetFunction.Index(v, 0, i)
 With CreateObject("Scripting.Dictionary")
 For Each k In vv
 .Item(k) = .Item(k) + 1
 Next
 h = 1
 For Each k In .Keys()
 If k <> "" Then
 If h > UBound(x, 2) Then
 ReDim Preserve x(1 To j, 1 To h)
 End If
 x(i, h) = i & "列:要素=" & k & ":要素数=" & .Item(k)
 h = h + 1
 End If
 Next
 End With
 Next
 Worksheets("Sheet2").Range("A1").Resize(UBound(x, 2), j).Value = _
 WorksheetFunction.Transpose(x)
 End Sub
 
 このまま Transpose 使う場合は要素数の制限があるのでデータ数に注意が必要です。
 
 
 |  |