Excel VBA質問箱 IV

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

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


11364 / 13644 ツリー ←次へ | 前へ→

【16496】VBAによるデータ取得について kata 04/7/29(木) 19:19 質問[未読]
【16497】Re:VBAによるデータ取得について IROC 04/7/29(木) 20:12 回答[未読]
【16499】Re:VBAによるデータ取得について ichinose 04/7/30(金) 11:37 回答[未読]

【16496】VBAによるデータ取得について
質問  kata  - 04/7/29(木) 19:19 -

引用なし
パスワード
   はじめまして。VBAをはじめたばかりのものです。

ところで、質問なんですが、例えば5行5列の全部で25個のデータがあるとします。

このデータから同じデータが何個あるかって調べられるプログラムはどうやってVBAでプログラムを作成していけばよいのでしょうか?


例えば、データの中に5が3個あるとかっていう意味です。

どうか教えてください。

【16497】Re:VBAによるデータ取得について
回答  IROC  - 04/7/29(木) 20:12 -

引用なし
パスワード
   別シートに1列にコピーして、
フィルタオプションで重複を無視して抽出し、
そのリストでcountifなどの数式を使えば
求めることが出来ると思います。

【16499】Re:VBAによるデータ取得について
回答  ichinose  - 04/7/30(金) 11:37 -

引用なし
パスワード
   kata さん、IROCさん
こんにちは。

>はじめまして。VBAをはじめたばかりのものです。
>
>ところで、質問なんですが、例えば5行5列の全部で25個のデータがあるとします。
>
>このデータから同じデータが何個あるかって調べられるプログラムはどうやってVBAでプログラムを作成していけばよいのでしょうか?
>
>
>例えば、データの中に5が3個あるとかっていう意味です。

考え方は、IROCさんと同じですが、重複チェックをコレクションを使用しました。
A1〜E5にコード内でサンプルデータを作成しています。
結果は、H1、I1から表示です。

'=====================================================================
Sub main()
  Dim ans() As Variant
  Dim coc As Collection
  Dim myarray() As Variant
  Dim rng As Range
  Set rng = Range("a1:e5")
  With rng
   .Formula = "=choose(int(rand()*7)+1,""a"",""b"",""c"",""d"",""e"",""f"",""g"")"
   .Value = .Value
   '↑A1:E5にサンプル作成
   myarray() = .Value
   End With
  Set coc = mk_unique_collection(myarray())
  ReDim ans(1 To coc.Count, 1 To 2)
  For idx = 1 To coc.Count
   ans(idx, 1) = coc.Item(idx) & "は、"
   ans(idx, 2) = WorksheetFunction.CountIf(rng, coc.Item(idx))
   Next
  With Range("h1", Cells(coc.Count, 9))
   .Value = ans()
   .Sort key1:=Range("h1"), header:=xlNo
   End With
End Sub
'========================================================================
Function mk_unique_collection(myarray())
'重複しないデータのコレクションを作成する
'input : myarray() チェックする配列
'output: mk_unique_collection :重複の無いコレクション
  Dim myclct As New Collection
  On Error Resume Next
  For Each cval In myarray()
   myclct.Add cval, CStr(cval)
   Next
  Set mk_unique_collection = myclct
  Set myclct = Nothing
  On Error GoTo 0
End Function

確認してみて下さい。

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