Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


14688 / 76734 ←次へ | 前へ→

【67535】Re:出現の名称をDictionaryで出す
発言  kanabun  - 10/12/11(土) 9:50 -

引用なし
パスワード
   ▼Yoshim さん:
>Dictionaryで行き詰っています。
>
>商品出現回数_商品名_地域名
>   2     A   あ、き、す
>   3     C   さ 
>   1     B   た
>
>という表に仕上げたいのですが
>地域名のところに出すやり方がわかりません、

コードには地域名を出力する部分がありませんね?
ご提示のコードをできるだけ活かすとすると、こんな追加で
行けるのでは?

  Dictionaryに 商品をキー登録するとき、対応するアイテムに
  出力先の行番号を登録しておき、商品別に 決められた(一意の)
  行に出現回数のカウント、地域名の出力がされるように管理
  させます。

Sub trial2()
  Dim myR As Range, c As Range, r As Range
  Dim dic As Object, key
  Dim n As Long, k As Long
  Dim v, sLocal As String
  With Range("C:C")
    Set myR = Excel.Range(.Item(2), .Item(.Count).End(xlUp))
  End With
  With Range("G1:I1")
    .Resize(100).ClearContents
    .Value = Array("商品出現回数", "商品名", "地域名")
    Set r = .Offset(1)
  End With
  Set dic = CreateObject("Scripting.Dictionary")
  For Each c In myR
    v = c.Value
    If Not IsEmpty(v) Then
      If dic.Exists(v) Then
        k = dic(v)  '出力行番号を取得
      Else
        n = n + 1   '新規出力行番号
        dic(v) = n  '格納
        k = n
        r.Item(k, 2) = v
      End If
      r.Item(k, 1) = r.Item(k, 1).Value + 1 '出現回数
      sLocal = r.Item(k, 3).Value      '地域名
      If Len(sLocal) Then sLocal = sLocal & ","
      r.Item(k, 3) = sLocal & c(1, 0).Value
    End If
  Next
  Set dic = Nothing
End Sub

これでとりあえず行けると思いますが、セルへ毎回出力しているので
画面がチラついて処理が重たくなっていると思います。
最終的には 出力先範囲r と同じサイズの(十分な行数をもった)配列
を用意しておいて、処理は配列に対して行い、シートには最後に一回だけ
一括貼付けするようにすれば動作は軽く高速化できるとおもいます。
2 hits

【67534】出現の名称をDictionaryで出す Yoshim 10/12/11(土) 8:53 質問
【67535】Re:出現の名称をDictionaryで出す kanabun 10/12/11(土) 9:50 発言
【67538】Re:出現の名称をDictionaryで出す kanabun 10/12/11(土) 10:44 発言
【67540】Re:出現の名称をDictionaryで出す kanabun 10/12/11(土) 11:21 発言
【67537】Re:出現の名称をDictionaryで出す 山猿 10/12/11(土) 10:20 発言
【67539】Re:出現の名称をDictionaryで出す UO3 10/12/11(土) 11:07 回答
【67542】Re:出現の名称をDictionaryで出す Yoshim 10/12/11(土) 11:52 お礼

14688 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free