Excel VBA質問箱 IV

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

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


4631 / 76735 ←次へ | 前へ→

【77722】Re:縦並びを横並びにしたいです。
発言  β  - 15/12/6(日) 14:39 -

引用なし
パスワード
   ▼さと さん:

二番煎じですが。


Sub Test()
  Dim dic As Object
  Dim c As Range
  Dim w As Variant
  Dim tmp As Variant
  Dim mx As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  
  For Each c In Range("D2", Range("D" & Rows.Count).End(xlUp))
    dic(c.Value) = Array(dic.Count + 1, 0)
  Next
  
  ReDim w(1 To dic.Count, 1 To Columns.Count)
  
  For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
    If dic.exists(c.Value) Then
      tmp = dic(c.Value)
      tmp(1) = tmp(1) + 1
      w(tmp(0), tmp(1)) = c.Offset(, 1).Value
      w(tmp(0), tmp(1) + 1) = c.Offset(, 2).Value
      If tmp(1) + 1 > mx Then mx = tmp(1) + 1
      tmp(1) = tmp(1) + 2
      dic(c.Value) = tmp
    End If
  Next
  
  ReDim Preserve w(1 To UBound(w, 1), mx)
  Range("E2").Resize(UBound(w, 1), UBound(w, 2)).Value = w
  
End Sub

1 hits

【77720】縦並びを横並びにしたいです。 さと 15/12/6(日) 12:50 質問[未読]
【77721】Re:縦並びを横並びにしたいです。 γ 15/12/6(日) 13:58 発言[未読]
【77725】Re:縦並びを横並びにしたいです。 さと 15/12/6(日) 18:18 お礼[未読]
【77722】Re:縦並びを横並びにしたいです。 β 15/12/6(日) 14:39 発言[未読]
【77723】Re:縦並びを横並びにしたいです。 β 15/12/6(日) 15:23 発言[未読]
【77727】Re:縦並びを横並びにしたいです。 さと 15/12/6(日) 18:53 お礼[未読]

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