複数集計をしたい

質問

こんにちは。http://www.ken3.org/を参考にしながら、下記までたどり着いたのですが、
<%
QA = -1
If Request.QueryString("a4") = "on" Then QA = 4
If Request.QueryString("a3") = "on" Then QA = 3
If Request.QueryString("a2") = "on" Then QA = 2
If Request.QueryString("a1") = "on" Then QA = 1
If Request.QueryString("a0") = "on" Then QA = 0

If QA >= 0 Then
Call test108_WRITE(QA)
Call test108_SUM()
Else
%>
<FORM ACTION="*****.asp" METHOD="GET">
<table width="500" border="0" cellspacing="2" cellpadding="2">
<tr>
<td><font size="2">Q.しつもん</font></td>
</tr>
<tr>
<td><font size="2">
<INPUT TYPE="checkbox" NAME="a4">
ああああ</font></td>
</tr>
<tr>
<td><font size="2">
<INPUT TYPE="checkbox" NAME="a3">
いいいいい</font></td>
</tr>
<tr>
<td><font size="2">
<INPUT TYPE="checkbox" NAME="a2">
ううううう</font></td>
</tr>
<tr>
<td><font size="2">
<INPUT TYPE="checkbox" NAME="a1">
えええええ</font></td>
</tr>
<tr>
<td><font size="2">
<input type="checkbox" name="a0">
おおおおお</font></td>
</tr>
</table>
<br>
<br>
<INPUT TYPE="submit" VALUE="送　信">
<INPUT TYPE="reset" VALUE="入力クリア">
</FORM>
<% End If %>
<%

Sub test108_WRITE(QA)

Set objFS = Server.CreateObject("Scripting.FileSystemObject")

Set ts = objFS.OpenTextFile(Server.MapPath("*****.txt"), 8, True)

ts.write QA & ","
ts.write strMSG & ","
ts.write Now & ","
ts.write Request.ServerVariables("REMOTE_ADDR") & ","
ts.write Request.ServerVariables("HTTP_USER_AGENT")
ts.write chr(13) & chr(10)

ts.close

Response.Write "<font size=2>ご協力ありがとうございました。</font><br><br>"
Response.Write "<font size=2>Q.しつもん</font><br>"

Call test016_SUM()

End Sub

Sub test016_SUM()

dim strRECORD
dim nCNT(10)
dim nSUM

nSUM = 0

For i = 0 to 10
nCNT(i) = 0
Next

Set objFS = Server.CreateObject("Scripting.FileSystemObject")

Set ts = objFS.OpenTextFile(Server.MapPath("*****.txt"), 1, true)

Do While ts.AtEndOfStream = False
strRECORD = ts.ReadLine
i = Cint(Left(strRECORD, 1))
nCNT(i) = nCNT(i) + 1
nSUM = nSUM + 1
Loop

ts.close

strBOX = Array("おおおおお" , "えええええ" , "ううううう" , "いいいいい" , "あああああ")

Response.Write "<table cellspacing=0 cellpadding=0 border=0>"
Response.Write "<br>"
For i = 4 To 0 Step -1
Response.Write "<tr>"
Response.Write "<td align=left width=200px><font size=2>" & strBOX(i) & "</font></td>"
strMSG = FormatNumber(CInt((nCNT(i) / nSUM) * 200), 1)
Response.Write "< td background=img/graphbg.gif align=left width=200px><font size=2> <img src=img/graphbar.gif width=" & strMSG & " height=13>< /font></td>"
strMSG = FormatNumber((nCNT(i) / nSUM) * 100, 1)
Response.Write "<td align=right width=50px><font size=2>" & strMSG & "%</font></td></tr>"
Response.Write "</tr>"
Next

Response.Write "</table>"

End Sub

%>
これだと「型が一致しません。: 'Cint'」という表示が出てなかなかうまくいかず手詰まりの状態になってしまいました。
皆様のお力をお貸し下さいませ。宜しくお願い致します。

回答No.6

noname#53661 · ベストアンサー

ちょっとIISの環境が無かったのでXPで作って動かしてみました。
多少修正しましたが、ほとんど最初のままで普通に動作しましたよ。
ただ複数回答の仕様にはなってないのでa0 > a1 > ～ a4のような優先順位になりますね。

一応、動作したソースをそのまま書きます。ほとんど変えてませんが二重表示されるところや無駄なスペース等を多少修正してます。

<%
QA = -1
If Request.QueryString("a4") = "on" Then QA = 4
If Request.QueryString("a3") = "on" Then QA = 3
If Request.QueryString("a2") = "on" Then QA = 2
If Request.QueryString("a1") = "on" Then QA = 1
If Request.QueryString("a0") = "on" Then QA = 0

If QA >= 0 Then
Call test108_WRITE(QA)
Call test108_SUM()
Else
%>
<FORM ACTION="index.asp" METHOD="GET">
<table width="500" border="0" cellspacing="2" cellpadding="2">
<tr>
<td><font size="2">Q.しつもん</font></td>
</tr>
<tr>
<td><font size="2">
<INPUT TYPE="checkbox" NAME="a4">
ああああ</font></td>
</tr>
<tr>
<td><font size="2">
<INPUT TYPE="checkbox" NAME="a3">
いいいいい</font></td>
</tr>
<tr>
<td><font size="2">
<INPUT TYPE="checkbox" NAME="a2">
ううううう</font></td>
</tr>
<tr>
<td><font size="2">
<INPUT TYPE="checkbox" NAME="a1">
えええええ</font></td>
</tr>
<tr>
<td><font size="2">
<input type="checkbox" name="a0">
おおおおお</font></td>
</tr>
</table>
<br>
<br>
<INPUT TYPE="submit" VALUE="送　信">
<INPUT TYPE="reset" VALUE="入力クリア">
</FORM>
<% End If %>
<%

Sub test108_WRITE(QA)

Set objFS = Server.CreateObject("Scripting.FileSystemObject")

Set ts = objFS.OpenTextFile(Server.MapPath("data.txt"), 8, True)

ts.write QA & ","
ts.write strMSG & ","
ts.write Now & ","
ts.write Request.ServerVariables("REMOTE_ADDR") & ","
ts.write Request.ServerVariables("HTTP_USER_AGENT")
ts.write chr(13) & chr(10)

ts.close

Response.Write "<font size=2>ご協力ありがとうございました。</font><br><br>"
Response.Write "<font size=2>Q.しつもん</font><br>"

End Sub

Sub test108_SUM()

dim strRECORD
dim nCNT(10)
dim nSUM

nSUM = 0

For i = 0 to 10
nCNT(i) = 0
Next

Set objFS = Server.CreateObject("Scripting.FileSystemObject")

Set ts = objFS.OpenTextFile(Server.MapPath("data.txt"), 1, true)

Do While ts.AtEndOfStream = False
strRECORD = ts.ReadLine
i = Cint(Left(strRECORD, 1))
nCNT(i) = nCNT(i) + 1
nSUM = nSUM + 1
Loop

ts.close

strBOX = Array("おおおおお" , "えええええ" , "ううううう" , "いいいいい" , "あああああ")

Response.Write "<table cellspacing=0 cellpadding=0 border=0>"
For i = 4 To 0 Step -1
Response.Write "<tr>"
Response.Write "<td align=left width=200px><font size=2>" & strBOX(i) & "</font></td>"
strMSG = FormatNumber(CInt((nCNT(i) / nSUM) * 200), 1)
Response.Write "<td background=img/graphbg.gif align=left width=200px><font size=2> <img src=img/graphbar.gif width=" & strMSG & " height=13></font></td>"
strMSG = FormatNumber((nCNT(i) / nSUM) * 100, 1)
Response.Write "<td align=right width=50px><font size=2>" & strMSG & "%</font></td></tr>"
Response.Write "</tr>"
Next

Response.Write "</table>"

End Sub
%>

補足

Harland様
わざわざコードまで書いていただきありがとうございます。
確かに2重表示はなくなっていました。
やはり複数回答はこのコードでは難しいのでしょうか？
何から何まで申し訳ありませんが、宜しくお願い致します。

回答No.5

noname#53661

すみません、全体を見る時間がないので気が付いた点をとりあえず

Do While ts.AtEndOfStream = False
Response.Write Left(strRECORD, 1)
strRECORD = ts.ReadLine
i = CLng(Left(strRECORD, 1))
nCNT(i) = 1
nSUM = 1
Loop

ここの意味は何でしょう？
ループして変数に代入したら変数の値は常に最後の行ですよね？

あと今現在出ているエラーメッセージは何とでるのでしょうか。

補足

Harland様
ご回答ありがとうございます。ご指摘の部分は参考にさせていただいたサイトは以下の通りでした。

○元のコード
Do While ts.AtEndOfStream = False 'ファイルの終端になってない間ループする
strRECORD = ts.ReadLine 'ファイルからデータを一行を読む
'Left関数を使って左から１文字目をCintで数値変換
i = Cint(Left(strRECORD, 1)) '読みこんだレコードの１文字目を数値変換
'nCNT(i番目)をカウントアップ
nCNT(i) = nCNT(i) + 1
'*2合計数は無条件にカウントアップ
nSUM = nSUM + 1
Loop

○変更点（元より3ヶ所変更）
　・i = Cint(Left(strRECORD, 1)) → i = CLng(Left(strRECORD, 1))
　・nCNT(i) = nCNT(i) + 1 → nCNT(i) = 1
・nSUM = nSUM + 1 → nSUM = 1

になります。あとエラーメッセージはなぜか出ていませんが、グラフの表示が上下にならんで2つ同じものが出ています。
何度も申し訳ございませんが、宜しくお願い致します。

回答No.4

noname#53661

分かりました。
42003311はIntegerで扱える範囲を超えてます。
CInt を　CLng　に変えてみては如何でしょうか。

補足

Harland様
素早いご対応ありがとうございます。
ご指示のあったようにしたのですが結果は同じでした。とりあえず現在の状況をお知らせ致します。
何度も申し訳ございませんが宜しくお願い致します。

Sub test108_SUM()

dim strRECORD
dim nCNT(10)
dim nSUM

Set objFS = Server.CreateObject("Scripting.FileSystemObject")

Set ts = objFS.OpenTextFile(Server.MapPath("data/data1.txt"), 1, true)

Do While ts.AtEndOfStream = False
Response.Write Left(strRECORD, 1)
strRECORD = ts.ReadLine
i = CLng(Left(strRECORD, 1))
nCNT(i) = 1
nSUM = 1
Loop

ts.close

strBOX = Array("おおおおお" , "えええええ" , "ううううう" , "いいいいい" , "あああああ")

Response.Write "<table cellspacing=0 cellpadding=0 border=0>"
Response.Write "<br>"
For i = 4 To 0 Step -1
Response.Write "<tr>"
Response.Write "<td align=left width=200px><font size=2>" & strBOX(i) & "</font></td>"
strMSG = FormatNumber(CLng((nCNT(i) / nSUM) * 200), 1)
Response.Write "<td background=img/graphbg.gif align=left width=200px><font size=2><img src=img/graphbar.gif width=" & strMSG & " height=13></font></td>" 'ALIGN=RIGHT追加
strMSG = FormatNumber((nCNT(i) / nSUM) * 100, 1)
Response.Write "<td align=right width=50px><font size=2>" & strMSG & "%</font></td></tr>"
Response.Write "</tr>"
Next

Response.Write "</table>"
Response.Write "<br>"
Response.Write "<font size=2><a href=index.html>トップページに戻る</a></font>"
End Sub

回答No.3

noname#53661

すみません、括弧が多かったですね。
Response.Write (Left(strRECORD, 1)ではなく
Response.Write Left(strRECORD, 1)ですね。
これで表示された値を確認してください。

下の方法でやってみると「False」と表示されたということはLeft(strRECORD, 1)の値が数値として扱えない値だということです。

補足

Harland様
度重なるご回答ありがとうございます。
ご指示のあるようにしてみると
----結果表示------
Q.しつもん
42003311
というように数字はとれましたが、2つ以上チェックすると
3,,2008/03/10・・・・
みたいな形でテキストファイルに書き込まれ（数字の少ない方が書き込まれます）、グラフ表示すべて100％になります。（50％、50％という形に成りません）
もう少しお力をお貸し頂けないでしょうか。
宜しくお願い致します。

回答No.2

noname#53661

i = Cint(Left(strRECORD, 1))
の部分で引っ掛かっているのでしたらまずはテキストから正しく読み込まれているか確認したほうが良いでしょう。

まあどこでもいいのですが、
i = Cint(Left(strRECORD, 1)) よりも前に
Response.Write strRECORD　もしくは
Response.Write (Left(strRECORD, 1)
として実際に値を目視で確認して数字を常に取れるか確認するのが良いかと思います。
Left(strRECORD, 1)で確実に数字が取得できても同じエラーが出るのでしたら試しに
Dim intRecord
intRecord = Left(strRECORD, 1)
If Not IsNumeric(intRecord) Then
Response.Write "False"
End If
とするのもありますが、そもそもVBScriptではすべてVariant型ですからCIntしなくても数字を読み込んでいれば演算すると思いますよ。

補足

Harland様
ご回答ありがとうございます。
>Response.Write (Left(strRECORD, 1)
とやってみましたが同じエラーのまま変わらなかった為、下の方法でやってみると「False」と表示されました。これはテキストファイルを読み込んでいないと言うことでしょうか？
度々申し訳ございませんが、宜しくお願い致します。

回答No.1

noname#53661

見落としがあったらすみません。

まず
For i = 0 to 10
nCNT(i) = 0
Next
これだと常にnCNT(i)は0ですよね？意味があるのでしょうか？

そして
nSUMはそのちょっと前に0が代入されてますのでnSUMも0です。

すると
nCNT(i) = nCNT(i) + 1
nSUM = nSUM + 1
これは
nCNT(i) = 1
nSUM = 1
と同義になります。

ということは
strMSG = FormatNumber(CInt((nCNT(i) / nSUM) * 200), 1)
strMSG = FormatNumber((nCNT(i) / nSUM) * 100, 1)
どちらも0にしかなりませんしFormatNumberの意味が分かりません。

何行目でエラーになるのか書かれてないので
i = Cint(Left(strRECORD, 1))
なのか
strMSG = FormatNumber(CInt((nCNT(i) / nSUM) * 200), 1)
のどちらでエラーになのか、テキストファイルから読み込まれる内容が分からないのでstrRECORDにどんな値が代入されるか分かりません。
CIntが無かったらどうなるか、お試しはされたでしょうか。
strRECORDにどんな値が代入されているか書き出して試してみる。
数値として読み込まれてないのかどうかをIsNumericで試してみるとかしてみたら如何ですか。

補足

Harland様
早速のご回答ありがとうございます。
>何行目でエラーになるのか書かれてないので
これは「i = Cint(Left(strRECORD, 1)) 」の方でひかかっていました。
その部分を削除し、「あああああ」の部分をチェックしてみたのですが、今度は2つグラフが表示され「おおおおお」の部分が100％の状態になり、テキストファイルには
「4,,2008/03/08・・・・・・」
と書き込まれていました。複数選択すると一番下のチェックボックスの数字が書き込まれるだけで複数書き込まれません。
>数値として読み込まれてないのかどうかをIsNumericで試してみるとか
>してみたら如何ですか。
とご指示頂いているのですが、具体的にどうしたらよろしいでしょうか。
重ね重ね申し訳ありませんが、宜しくお願い致します。