作成者	カテゴリ	返答の対象		公開
ますこ 12/16/2009 02:09 PM		配列に入っている値毎にカウントする

いつも参考にさせていただいてます。

先日首記文書タイトルで質問をさせていただきました。
このたび、二児の父様、とおりすがり様のアドバイスを
もとに、思うとおりの動作ができるようになりましたので
ご報告させていただきます。
すごく難しかったです（^^;）が、とても勉強になりました。

やりたかったことはｶﾃｺﾞﾘ毎に配列に入っている集計です。
ソースすべてはのせられませんので、ベースに使ったものを
他の方のためだけではなく、自分のためにも乗せておきます。
また、配列のソートは検索をしたところTakenoff Labsさんのところで
ｻﾝﾌﾟﾙがございましたのでお借りしました（ありがとうございました）

-----ここから--------------
Const COMBGAP = 1.3

Sub Initialize
Dim ss As New NotesSession
Dim db As NotesDatabase
Dim a List As Long 'longから変更した
Dim strTags As String

a(("あ")+"-"+("01")) = a(("あ")+"-"+("01")) + 1
strTags = |"01"|

a(("う") +"-"+("03")) = a(("う") +"-"+("03"))+ 1
strTags = StrTags & |:"03"|

a(("あ") +"-"+("01")) = a(("あ") +"-"+("01"))+ 1
strTags = StrTags & |:"01"|

a(("い") +"-"+("02")) = a(("い") +"-"+("02"))+ 1
strTags = StrTags & |:"02"|

a(("あ") +"-"+("01")) = a(("あ") +"-"+("01"))+ 1
strTags = StrTags & |:"01"|

a(("い") +"-"+("02")) = a(("い") +"-"+("02"))+ 1
strTags = StrTags & |:"02"|

a(("あ") +"-"+("01")) = a(("あ") +"-"+("01"))+ 1
strTags = StrTags & |:"01"|

a(("え") +"-"+("04")) = a(("え") +"-"+("04"))+ 1
strTags = StrTags &|:"04"|

a(("え") +"-"+("04")) = a(("え") +"-"+("04"))+ 1
strTags = StrTags &|:"04"|

Dim strA As String
Dim strArr() As String
Dim totalarr1() As String
Dim totalarr2() As String
Dim totalarr3() As Long
Dim i As Integer
i = 0

Forall v In a
Redim Preserve strArr(i)

strA= Listtag(v)
strArr(i) = strA

i = i + 1
End Forall
icount = i 'Listｶｳﾝﾄ

Dim getsortAry As Variant
Dim maxAry As Integer
getsortAry = Arysort(strArr)
maxAry = Ubound(getsortAry)
Dim y As Integer
y=0
For y = 0 To maxAry
Redim Preserve totalarr1(y)
Redim Preserve totalarr2(y)
Redim Preserve totalarr3(y)

totalarr1(y) = Left$(getsortAry(y),1)
totalarr2(y) = Strrightback(getsortAry(y),"-")
totalarr3(y) = s

If Iselement(a(getsortAry(y))) = True Then
totalarr3(y) = a(getsortAry(y))
Else
totalarr3(y) = 0
End If
Next
ycount = y

'新規文書作成
Set db = ss.CurrentDatabase
Set doc = New notesdocument(db)
doc.Form = "testform1"
max = ycount
i = 0
For x = 1 To max
Call doc.replaceitemvalue("a_"& Cstr(x),totalarr2(i))
Call doc.replaceitemvalue("b_"& Cstr(x),totalarr1(i))
Call doc.replaceitemvalue("c_"& Cstr(x),totalarr3(i))
i = i + 1
Next

Call doc.save(True,True)

End Sub
-------------------------
Function Arysort(strArr As Variant) As Variant
Dim varRetAry As Variant
Dim vartmp As Variant
Dim ingmin As Integer
Dim ingmax As Integer
Dim y As Long, j As Long
Dim inggap As Long
Dim blnend As Boolean

varRetAry = strArr
ingmin = Lbound(varRetAry)
ingmax = Ubound(varRetAry)
inggap = ingmax - ingmin
blnend = False
Do While inggap > 1 Or blnend = False
inggap = Int(inggap / COMBGAP)
If inggap = 9 Or inggap = 10 Then inggap = 11
If inggap < 1 Then inggap = 1
blnend = True
For y = ingmin To ingmax - inggap
j = y + inggap
If varRetAry(y) > varRetAry(j) Then
vartmp = varRetAry(y)
varRetAry(y) = varRetAry(j)
varRetAry(j) = vartmp
blnend = False
End If
Next
Loop
Arysort = varRetAry
End Function

アドバイスをくださったお二人に感謝いたします。
ありがとうございました。