連想配列が１つのセルにまとめれません！ 500行500例の値があります！ 一行に何の値が何件あるか集

連想配列が１つのセルにまとめれません！

500行500例の値があります！
一行に何の値が何件あるか集計したいのです。

A列に一行一行 1が1件2が２件3が３件4が４件5が5件
↓の行A列に 10が1件20が2件30が3件40が4件50が5件
以下この処理を500行を左端のA列にまとめて置きたいのです。


ご教示頂けたら幸いです。

下のソースだと、A列にまとめれません！
よろしくお願いいたします。

ソース
Sud countNumbers()
Dim i As Integer
Dim sline As Integer

sline = 1
Set sd = CreateObject(″Scripting.Dictionary″)

Application.ScreenUpdating= False

For i = 5 To 500
sNo=Worksheets(1).Cells(sline,i).Value
sd(sNo) = sd(sNo) ＋ 1

Next

Application.ScreenUpdating = True

i = 1
For Each sn In sd
Worksheets(1).Cells(1,i).Value = sn & ″が″ & sd(sn) & ″件″

i = i + 1
Next
Set sd = Nothing

End Sub

この値を配列に貯めて、１つのセルに参照したいのですが！
上手くいきません…

何回か質問していますが、上手くいきません。よろしくお願いいたします。

宜しくお願いします。

No.1 ベストアンサー 回答者： めぐみん_ 回答日時： 2017/12/17 20:48

Sub countNumbers()

　　Dim sd As Object
　　Dim i As Integer, j As Integer
　　Dim sline As Integer
　　Dim sNo As Integer
　　Dim str As String
　　Dim sn As Variant

　　sline = 1
　　Set sd = CreateObject("Scripting.Dictionary")

　　Application.ScreenUpdating = False

　　For j = 1 To 500

　　　　For i = 5 To 500
　　　　　　sNo = Worksheets(1).Cells(sline, i).Value
　　　　　　sd(sNo) = sd(sNo) + 1
　　　　Next

　　　　str = ""
　　　　For Each sn In sd
　　　　　　str = str & sn & "が" & sd(sn) & "件 "
　　　　Next

　　　　Worksheets(1).Cells(sline, 1).Value = str
　　　　sline = sline + 1
　　　　sd.RemoveAll

　　Next
　　Application.ScreenUpdating = True
　　Set sd = Nothing

End Sub

この回答へのお礼

あっまた、回答して頂いてありがとうございます。

すいません、やって見ます。

なぜか前回のは論理エラーでした！

またご連絡いたします。

お礼日時：2017/12/17 20:55