|
同じ商品名で 地域が重複していたばあい、重複カットして
表示するサンプルです。
Sub Trial3b() '配列利用
Dim myR As Range
Dim dic As Object
Dim i As Long, n As Long, k As Long
Dim v, sProdt As String, sLocal As String, sL As String
With Range("C:C")
Set myR = Excel.Range(.Item(2), .Item(.Count).End(xlUp))
v = myR.Offset(, -1).Resize(, 2).Value2
End With
ReDim outv(myR.Count, 1 To 3)
outv(0, 1) = "商品出現回数"
outv(0, 2) = "商品名"
outv(0, 3) = "地域名"
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(v)
If Not IsEmpty(v(i, 2)) Then
sProdt = v(i, 2)
If dic.Exists(sProdt) Then
k = dic(sProdt) '出力行番号を取得
Else
n = n + 1 '新規出力行番号
dic(sProdt) = n '格納
k = n
outv(k, 2) = sProdt
End If
outv(k, 1) = outv(k, 1) + 1 '出現回数
sLocal = outv(k, 3)
If Len(sLocal) = 0 Then sLocal = " "
sL = " " & v(i, 1) & " "
If InStr(sLocal, sL) = 0 Then
outv(k, 3) = sLocal & sL
End If
End If
Next
Set dic = Nothing
With Range("G1").Resize(, 3)
.Resize(myR.Count).ClearContents
With .Resize(n + 1)
.Value = outv
With .Columns(3)
.Value = Application.Substitute( _
Application.Trim(.Cells), " ", "、")
End With
End With
End With
End Sub
|
|