Excel VBA質問箱 IV

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

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


5575 / 13645 ツリー ←次へ | 前へ→

【50074】複数の同一名を一つにまとめる アーサー 07/7/7(土) 22:55 質問[未読]
【50075】Re:複数の同一名を一つにまとめる ichinose 07/7/7(土) 23:48 発言[未読]
【50077】Re:複数の同一名を一つにまとめる アーサー 07/7/8(日) 1:43 お礼[未読]

【50074】複数の同一名を一つにまとめる
質問  アーサー  - 07/7/7(土) 22:55 -

引用なし
パスワード
   こんなこと出来ないでしょうか?

  A   B   C   D   E   F   G   H
1 5B  3Y  1A  3Y  4B  5B  1A  3Y

となっているのを、
      
     ↓

  A    B    C   D
1 1A×2 3Y×3 4B  5B×2

【50075】Re:複数の同一名を一つにまとめる
発言  ichinose  - 07/7/7(土) 23:48 -

引用なし
パスワード
   ▼アーサー さん:
こんばんは。

>こんなこと出来ないでしょうか?

1行目が

>  A   B   C   D   E   F   G   H
>1 5B  3Y  1A  3Y  4B  5B  1A  3Y
>
となっているデータから、
      
>     ↓
>
>  A    B    C   D
2 1A×2 3Y×3 4B  5B×2

2行目に上記にまとめる事を考えると・・・、


標準モジュールに
'=============================================================
Sub main()
  Dim col As Long
  Dim k As Variant
  Dim crng As Range
  Dim rng As Range
  Dim dic As Object
  Set dic = CreateObject("scripting.dictionary")
  Set rng = Range("a1", Cells(1, Columns.Count).End(xlToLeft))
  With dic
    For Each crng In rng
     If .Exists(crng.Value) = False Then
      .Add crng.Value, 1
     Else
      .Item(crng.Value) = .Item(crng.Value) + 1
      End If
     Next
    col = 1
    For Each k In .Keys
     If .Item(k) = 1 Then
       Cells(2, col).Value = k
     Else
       Cells(2, col).Value = k & " × " & .Item(k)
       End If
     col = col + 1
     Next
    Range("A2", Cells(2, col)).Sort Key1:=Range("A2"), _
     Order1:=xlAscending, Header:=xlNo, _
      OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlLeftToRight, SortMethod _
      :=xlPinYin, DataOption1:=xlSortNormal
    End With
  Set dic = Nothing
End Sub

これで試してみてください。

【50077】Re:複数の同一名を一つにまとめる
お礼  アーサー  - 07/7/8(日) 1:43 -

引用なし
パスワード
   ichinose さん、ありがとうございます。

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