Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

71943 / 76807

←次へ　｜　前へ→


	【9357】Re:ユニークな数値を数えたい。

りん

- 03/11/30(日) 17:54 -


	引用なし

	パスワード

まゆんさん、こんばんわ。

>あの～。恐れ入りますもうひとつ質問させてください。
>ExcelのCellの中に下記のような表があると例えます。

>A1　データ
>A2　００１
　<<略>>
>A9　００６
>A10 ００７

>上記の表を例にすると答えは６です。
だとして。

Sub Test()
　 With Range("A1:A10")
　　　.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
　　　'Rangeは分断されていると一番上だけしかCountで返さなくなるので
　　　'Areasで全部チェックして足していく
　　　For Each c In .SpecialCells(xlCellTypeVisible).Areas
　　　　 RR& = RR& + c.Rows.Count
　　　Next
　　　'１行目はタイトル行なのでデータの行数は　-1
　　　MsgBox RR& - 1, vbInformation, "Unique"
　 End With
　
End Sub

ベタに数えていく場合
Sub test()
　 Dim Rmax&, Rpos&, Flg As Boolean
　 Rmax& = 10 'A10まで検索するとして
　 Rpos& = 0
　 ReDim cdat(1 To Rmax&) As Variant '内容保管用
　 '
　 For RR& = 2 To Rmax&
　　　With Cells(RR&, 1)
　　　　 If .Value <> "" Then
　　　　　　Flg = True
　　　　　　For NN& = 1 To Rpos&
　　　　　　　 If cdat(NN&) = .Value Then
　　　　　　　　　Flg = False: Exit For
　　　　　　　 End If
　　　　　　Next
　　　　　　'チェック後重複が無ければ配列に入れる
　　　　　　If Flg = True Then
　　　　　　　 Rpos& = Rpos& + 1
　　　　　　　 cdat(Rpos&) = .Value
　　　　　　End If
　　　　 End If
　　　End With
　 Next
　 MsgBox Rpos&, vbInformation, "Unique"
　 Erase Cdat
End Sub

ichinoseさんの配列数式も面白そうですね。

1 hits

▼

【9348】ユニークな数値を数えたい。 まゆん 03/11/30(日) 15:45