Retrieve values from excel sheet

[sravsand]

In an excel sheet having many rows and columns, in this there are 2 columns those are
questionnumber | Answers
1 a
2 c
3 b
1 c
4 d
2 d
. .
. .

here my question is what is the percentage of answers for each question number,
Output ex:
QuestionNumber | a% | b%| c%| d%|
1 |50|0|50|0|
2 |0|0|50|50|

like this for all question numbers. and this result should be inserted in new excel sheet

Thanks inadvance

[anandanlk]

Hi,

Use the following logic

just store in another excel(just name the 1st row headers as No, A, B, C and D respectively-one time)

get the first row details from excel u have
for example 1 a means
so just add 1 to the 2nd column(A) of 1st Question
No A B C D
1 1

get 2nd row from ur excel
For ex 4 b means
so just add 1 to the 3rd column(B) of 4th Question
No A B C D
4 1

get 3rd row from ur excel
For ex 1 b means
so just add 1 to the 3rd column(B) of 1st Question
No A B C D
1 1 1

get 4th row from ur excel
For ex 1 b means
so just add 1 to the 3rd column(B) of 1st Question
No A B C D
1 1 2

likewise get all rows from ur excel and add values

finally the excel will look like following
No A B C D
1 1 2 2 0
2 2 2 0 0
3 1 1 2 1

Get total for each
No A B C D tot
1 1 2 2 0 5
2 2 2 0 0 4
3 1 1 2 1 5

Result
No A B C D tot A% B% C% D%
1 1 2 2 0 5 1/5*100 2/5*100 2/5*100 0
2 2 2 0 0 4 2/4*100 2/4*100 0 0
3 1 1 2 1 5

Note: if value is zero means dont divide. otherwise u will get zero divide exception

I hope u know how to access values from excel

[sravsand]

we don't know how many rows in questionnumber, it may have many rows, i need just filter all the rows by question number and percentages of answers. In the answers field it may have true/false or A,B,c. Could u please write the script for it.


Thanks
sandeep

[tarun]

Try the below code

Code:

Set objExcel = CreateObject("Excel.Application") objExcel.Workbooks.Open "c:/test.xls" Set objSheet = objExcel.ActiveWorkbook.Worksheets(1) 'Declare a constant for total number of questions Const QuesNo = 5 'Declare a constant for total number of possible answers Const TotAns = 4 'Declare an array to store the number of results for a question Dim aResults() ReDim Preserve aResults(QuesNo - 1,TotAns - 1) 'Declare an array to store total number of a particular question Dim aQues() ReDim Preserve aQues(QuesNo - 1) 'Declare a dynamic array to store the percentages Dim aResPer() ReDim Preserve aResPer(QuesNo-1,TotAns-1) 'Initialize the arrays to 0 value For i = 0 To QuesNo - 1 aQues(i) = 0 For j = 0 To TotAns - 1 aResults(i,j) = 0 Next Next Row_Count = 0 Loop_Control = True Do While Loop_Control Row_Count = Row_Count + 1 Loop_Control = True If objSheet.Cells(Row_Count,1) = "" Then Loop_Control = False End If Loop For j = 0 To QuesNo - 1 For i = 2 To Row_Count - 1 If CInt(objSheet.Cells(i,1)) = j + 1 Then Select Case CStr(objSheet.Cells(i,2)) Case "a" aResults(j,0) = aResults(j,0) + 1 Case "b" aResults(j,1) = aResults(j,1) + 1 Case "c" aResults(j,2) = aResults(j,2) + 1 Case "d" aResults(j,3) = aResults(j,3) + 1 End Select End If Next Next For i = 0 To QuesNo - 1 For j = 0 To TotAns - 1 aQues(i) = aQues(i) + aResults(i,j) Next Next For i = 0 To QuesNo - 1 For j = 0 To TotAns - 1 aResPer(i,j) = (aResults(i,j)/aQues(i))*100 Next Next Set objSheet = Nothing 'Write the results to new excel objExcel.Workbooks.Add Set objSheet = objExcel.ActiveWorkbook.Worksheets(1) objSheet.Name = "Results" objSheet.Cells(1,1) = "QuestionNo" objSheet.Cells(1,2) = "a%" objSheet.Cells(1,3) = "b%" objSheet.Cells(1,4) = "c%" objSheet.Cells(1,5) = "d%" For i = 2 To QuesNo + 1 objSheet.Cells(i,1) = i - 1 Next For i = 2 To QuesNo + 1 For j = 2 To TotAns + 1 objSheet.Cells(i,j) = aResPer(i-2,j-2) Next Next ObjExcel.ActiveWorkbook.SaveAs "c:\Results.xls", 56 ObjExcel.ActiveWorkbook.Close objExcel.Application.Quit Set objSheet = Nothing Set objExcel = Nothing