|
こんにちは
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 使う場合は要素数の制限があるのでデータ数に注意が必要です。
|
|