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