| |
> 配列を用意しておいて､処理は配列に対して行い､
> シートには最後に一回だけ一括貼付けする
ように書き直すと、以下の感じになると思います。
Sub Trial3() '配列利用
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
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) Then sLocal = sLocal & ","
outv(k, 3) = sLocal & v(i, 1)
End If
Next
Set dic = Nothing
With Range("G1").Resize(, 3)
.Resize(myR.Count).ClearContents
.Resize(n + 1).Value = outv
End With
End Sub
ただ 山葵さんのコメントにあるように、
> If InStr(dic(v), region) = 0 Then 'これは不要かも
同じ商品名で 地域名が重複して出てきたばあい
↓
地域名 商品名
あ AA
あ AA
あ AA
さ AA
商品「AA」の出現回数は 4回 で OK ですが、現状コードでは
地域名は「あ、あ、あ、さ」となってしまいます。
同じ商品で地域名はダブることはないのであればこのままでよい
のですが、重複して地域名が出現することがあるのであれば、どう
表示するのか、仕様を決めておかないといけないですね
|
|
kanabun
- 10/12/11(土) 10:44 -
